Excel - One macro for multiple row tasks

March 2017



Issue


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.

Solution



You can use this:
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

Note


Thanks to rizvisa1 for this tip on the forum.

Related


Published by aakai1056.
This document, titled "Excel - One macro for multiple row tasks," is available under the Creative Commons license. Any copy, reuse, or modification of the content should be sufficiently credited to CCM (ccm.net).