Marco help! One macro for multiple row tasks

[Solved/Closed]
Report
-
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
-
Hello,

I have two separate workbooks that I need to compare. Task at hand is I have to find specific text in workbook 2 (col A) and once found - I then have to copy the next two cells/rows (col B and C) and paste it in wkbook 1 (col B and C) for each individual row for the text found. The ones that are not found, can be left alone or blank.

Is that even possible?

Thank you for your help.

1 reply

Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
Dim mySearchText As String
Dim wb1, wb2 As Workbook
Dim sh1, sh2 As Sheets

Set wb1 = Workbooks("Book1")
Set wb2 = Workbooks("Book2")

Do While True
mySearchText = InputBox("Enter Text to Search For. Enter blank to quit operation.", "Search for")

If (mySearchText = "") Then Exit Sub


wb2.Activate
wb2BRow = Cells(65536, 2).End(xlUp).Row
wb2CRow = Cells(65536, 3).End(xlUp).Row
If (wb2BRow > wb2CRow) Then
wb2row = wb2BRow
Else
wb2row = wb2CRow
End If

If wb2row = 1 Then wb2row = 2


wb1.Activate

On Error Resume Next

If ActiveSheet.AutoFilterMode Then
Cells.Select
Selection.AutoFilter
End If

If ActiveSheet.AutoFilterMode = False Then
Rows(1).Select
Selection.AutoFilter
End If

On Error GoTo 0

Selection.AutoFilter Field:=1, Criteria1:="=" & mySearchText, Operator:=xlAnd
Dim lastRow As Long
lastRow = Cells(65536, 1).End(xlUp).Row

If (lastRow > 1) Then

Range(Cells(2, 2), Cells(lastRow, 3)).Select
Selection.Copy
wb2.Activate
Cells(wb2row, 2).Select
Selection.PasteSpecial

wb2BRow = Cells(65536, 2).End(xlUp).Row
wb2CRow = Cells(65536, 3).End(xlUp).Row
If (wb2BRow > wb2CRow) Then
wb2row = wb2BRow
Else
wb2row = wb2CRow
End If
wb2row = wb2row + 1
End If
Loop
1
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2942 users have said thank you to us this month