Selected Answer
Here's the code you have been looking for. I have refrained from commenting the code but added good explanations to the variable declarations. Of course, you will need to change the two constants at the top before the code can run for you, even in the attached workbook. But the file specified in the code is a copy of your sample file "aa".
Sub UpdateInventory()
' 185
' change to suit: Path must end on backslash
Const SourcePath As String = "D:\PVT Archive\Class 1\1-2021 (Jan 2023)\"
Const SourceBook As String = "185 TXL 210303 Inventory Update (aa).xlsx"
Dim WbS As Workbook ' source book
Dim WsS As Worksheet ' source sheet
Dim WbT As Workbook ' target book
Dim WsT As Worksheet ' target sheet (in ThisWorkbook)
Dim Rs As Long ' Row: source
Dim Rt As Long ' Row: target
Dim Cl As Long ' last used column in WsS
Dim Ct As Long ' target column in WsT
Dim C As Long ' loop counter: column
Dim Target As Range ' search range in WsT
Dim Fnd As Range ' result of Find function
Dim FirstFound As Long ' Target.Row where first match was found
Dim Arr As Variant ' source data: Rt
Set WbT = ThisWorkbook
Set WsT = WbT.Worksheets("Sheet1")
With WsT
Set Target = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
Ct = .Cells(2, .Columns.Count).End(xlToLeft).Column + 1
End With
Application.ScreenUpdating = False
On Error Resume Next
Set WbS = Workbooks(SourceBook)
If Err Then Set WbS = Application.Workbooks.Open(SourcePath & SourceBook)
On Error GoTo 0
Set WsS = WbS.Worksheets("Sheet1")
With WsS
Cl = .Cells(1, .Columns.Count).End(xlToLeft).Column
For Rs = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
Arr = .Range(.Cells(Rs, 1), .Cells(Rs, Cl)).Value
Set Fnd = Target.Find(Arr(1, 2), , xlValues, xlWhole)
If Not Fnd Is Nothing Then
FirstFound = Fnd.Row
Do
If Fnd.Offset(0, 1).Value = Arr(1, 3) And _
Fnd.Offset(0, 2).Value = Arr(1, 4) Then
Fnd.Offset(0, Ct - Fnd.Column).Value = Arr(1, 7)
Exit Do
End If
Set Fnd = Target.FindNext(Fnd)
If Not Fnd Is Nothing Then
If Fnd.Row = FirstFound Then Set Fnd = Nothing
End If
Loop While Not Fnd Is Nothing
End If
If Fnd Is Nothing Then
With WsT
Rt = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Rows(Rt - 1).Copy
.Rows(Rt).Insert Shift:=xlDown
.Rows(Rt).ClearContents
.Cells(Rt, 1).Value = .Cells(Rt - 1, 1).Value + 1
For C = 2 To 4
.Cells(Rt, C).Value = Arr(1, C)
Next C
.Cells(Rt, Ct).Value = Arr(1, 7)
End With
End If
Next Rs
End With
Application.ScreenUpdating = True
End Sub
The code should be in your file "bb". It must be in a standard code module, not any of the code modules provided by Excel automatically.
If the source workbook isn't open the code will open it. The procedure will look for a match in column B (that's Columns(2)) and skip that match if the other two columns are different. If no match is found a row is appended, taking the formats from the last previously existing row. If you run the code again (in error), the results of the second run will be written to the next column.