Marco help! One macro for multiple row tasks

Solved/Closed
MadLady - Jan 28, 2010 at 12:28 PM
rizvisa1 Posts 4479 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - Jan 29, 2010 at 08:03 PM
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

rizvisa1 Posts 4479 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 768
Jan 29, 2010 at 08:03 PM
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