In support of the answer to these forum Thread posts
https://www.excelforum.com/excel-pro...een-files.html
https://excelfox.com/forum/showthrea...ll=1#post14130
Code:
' https://www.excelforum.com/excel-programming-vba-macros/1319768-if-condition-met-then-put-the-remark-between-files.html#post5353174
Sub karmapala()
'Dim arr() As Variant
Dim Wb1 As Workbook, Wb2 As Workbook, Sh1 As Worksheet, Sh2 As Worksheet
Set Wb1 = Workbooks("1.xls")
Set Sh1 = Wb1.Worksheets.Item(1) ' Wb1.Sheets("1-Sheet1")
Dim Rng As Range ' For main data range in 1.xls
' Set Rng = Sh1.Range("D2", Sh1.Range("D" & Rows.Count).End(xlUp)) ' This and the next line will error if macro.xlsm is active when the macro is run as Rows.Count will give a much larger number ( 1048576 ) than there are rows in a pre Excel 2007 worksheet ( .
' Set Rng = Sh1.Range(Sh1.Range("D2"), Sh1.Range("D" & Rows.Count).End(xlUp))'
Set Rng = Sh1.Range("D2", Sh1.Range("D" & Sh1.Rows.Count).End(xlUp))
Set Wb2 = Workbooks("macro.xlsm") ' Workbooks("Macro.xlsm")
Set Sh2 = Wb2.Worksheets.Item(1) ' Wb2.Sheets("Sheet1")
Dim X As Long
X = 0
Rem 2 In this section we build an array, arr(), of column I values to be ... match Column I of 1.xls with column B of macro.xlsm
Dim Cel As Range
For Each Cel In Rng
Dim arr() As Variant ' This will become the array of column I values to be ... match Column I of 1.xls with column B of macro.xlsm
If Cel.Value = Cel.Offset(0, 1).Value And Cel.Value <> Cel.Offset(0, 2).Value Then
' If column D of 1.xls is equal to Column E of 1.xls & column D of 1.xls is not equal to column F of 1.xls Then ...
ReDim Preserve arr(X)
arr(X) = Cel.Offset(0, 5) ' This is the column I value for ... match Column I of 1.xls with column B of macro.xlsm
X = X + 1 ' to make the array element for the next entry, should there be one
End If
'If Cel.Value <> Cel.Offset(0, 1) And Cel.Value = Cel.Offset(0, 2) Then
If Cel.Value = Cel.Offset(0, 2) And Cel.Value <> Cel.Offset(0, 1) Then ' ...
ReDim Preserve arr(X)
ReDim Preserve arr(X)
arr(X) = Cel.Offset(0, 5) ' This is the column I value for ... match Column I of 1.xls with column B of macro.xlsm
X = X + 1 ' to make the array element for the next entry, should there be one
End If
Next
If X = 0 Then Exit Sub
Rem 3 In this section we take each of the values in column I of 1.xls meeting the criteria - ... match Column I of 1.xls with column B of macro.xlsm
Dim El
For Each El In arr() ' arr take each value in column I meeting the criteria - and look for the match in a row in column B of macro.xlsm
Dim B As Range ' The matched cell in column B in macro.xlsm
Set B = Sh2.Range("B:B").Find(El, lookat:=xlWhole) ' Look for the matched cell in macro.xlsm
If Not B Is Nothing Then
Dim FirstAddress As String: FirstAddress = B.Address ' The first match address to check when the VBA .Find Methos starts again
Do
If B.Offset(0, 1).Value = "" Then
B.Offset(0, 1).Value = 1 ' row of match has remark 1 in column C
Else
B.End(xlToRight).Offset(0, 1).Value = B.End(xlToRight).Value + 1
End If
Set B = Sh2.Range("B:B").FindNext(B) ' Look for the Next matched cell in macro.xlsm
Loop While B.Address <> FirstAddress ' check when the VBA .Find Methos starts again
End If
Next
End Sub
Bookmarks