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




Reply With Quote
Bookmarks