Please help me finish the last piece to this macro!

[cjvenables]

Can someone help me finish this?

This macro searches through 12 tabs (January SAP, February SAP, etc). When it finds the vendor number listed below, it copies the whole row and pastes it to a whole sheet. The problem is that it only returns 1 row for each month. I know for certain that this vendor has roughly 4K results, so I need this macro to find all results and paste them onto a new sheet. 12 separate tabs>1 consolidated tab.

I have found macros that returns all rows in one tab, but finding one that returns all rows across all tabs has been elusive. Sounds more like an IF statement than a FIND?

I'm almost there and need your help!

Also, if I wanted this to return multiple vendors, how could I have it search by multiple numbers?

Thanks!

Sub Copy_Vendor_Rows()
Dim i As Integer, Nextrow As Long
Dim FindVend As Range, Vendor As Variant
Dim wsDest As Worksheet

Set wsDest = Sheets("Sheet2") 'Destination worksheet
Nextrow = 1 'starting row on destination worksheet
Vendor = 12345 'Find vendor number
For i = 1 To 12
With Sheets(MonthName(i) & " SAP")
Set FindVend = .Range("H:H").Find(Vendor, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not FindVend Is Nothing Then
FindVend.EntireRow.Copy _
Destination:=wsDest.Rows(Nextrow)
Nextrow = Nextrow + 1
End If
End With
Next i
End Sub
_________________

 

[djreiswig]

Maybe this will help. It searches all open workbooks and all sheets in them for a text string. You could probably modify it to copy the data to a new sheet instead of displaying a message box. If not, it is handy anyway, since you can't find across sheets with the normal Excel find. I have it assigned to a button on my toolbar.

Sub SearchBooks()

Static SearchWord

IPB = InputBox("Enter the string to search for", "Search All Worksheets", SearchWord)
'remembers the last search
If IPB = "" Then Exit Sub Else SearchWord = IPB

For i = 1 To Workbooks.Count
Workbooks(i).Activate
For j = 1 To Sheets.Count
Worksheets(j).Activate
Range("A1").Activate
FindAnother:
Set WordAddress = Cells.Find(What:=SearchWord, after:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If WordAddress Is Nothing Then
Else:
If WordAddress.Address = CheckCell Then GoTo NextSheet
If ActiveCell.Address = "$A$1" Then CheckCell = WordAddress.Address
Address = WordAddress.Address
Range(Address).Activate
'yes=6 no = 7
continue = MsgBox("""" & SearchWord & """ found in " & ActiveWorkbook.Name _
& " " & ActiveSheet.Name & ". Continue searching?", vbYesNo, "SearchBooksMacro")
If continue = 7 Then
    Range(Address).Activate
    GoTo Done
End If
GoTo FindAnother
End If
NextSheet:
Next j
Next i
MsgBox "Finished Searching", , "SearchBooksMacro"
Done:
End Sub

 

[djreiswig]

Okay, I think I have your code modified to work as you want.

Sub Copy_Vendor_Rows()
    Dim i As Integer, j As Integer, Nextrow As Long
    Dim FindVend As Range, Vendor As Variant
    Dim wsDest As Worksheet
    
    Set wsDest = Sheets("Sheet2") 'Destination worksheet
    Nextrow = 1 'starting row on destination worksheet
    Vendor = 12345 'Find vendor number
    For i = 1 To 12
        With Sheets(MonthName(i) & " SAP")
            Set FindVend = .Range("H" & .Rows.Count).End(xlUp)
            For j = 1 To Application.WorksheetFunction.CountIf(.Columns(8), Vendor)
                Set FindVend = .Range("H:H").Find(What:=Vendor, After:=FindVend, _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
                If Not FindVend Is Nothing Then
                    FindVend.EntireRow.Copy _
                    Destination:=wsDest.Rows(Nextrow)
                    Nextrow = Nextrow + 1
                End If
            Next j
        End With
    Next i
End Sub

 

[djreiswig]

I think you can get rid of the if...then as well, since it only loops the number of times that the vendor number appears. The find should never fail.

 

[cjvenables]

I think you can get rid of the if...then as well, since it only loops the number of times that the vendor number appears. The find should never fail.

djreiswig,

Thanks so much! I will let you know how it works.

How would I search for more than 1 vendor number, and also, how would I search a workbook that had different named worksheets? For example, 1 sheet is named data, 1 employees, 1 hours worked, 1 monthly sales? Or, how do you search across different sheets (Sheet 1,2,3,4,5). That's where I get tripped up the most.

Thanks again for your help.

 

[djreiswig]

Try this out. Searches across multiple sheets and for multiple vendor numbers.

Sub Copy_Vendor_Rows()
    Dim i As Integer, j As Integer, k As Integer, Nextrow As Long
    Dim FindVend As Range, Vendor As Variant, SearchSheets As Variant
    Dim wsDest As Worksheet
    
    Set wsDest = Sheets("Sheet2") 'Destination worksheet
    Nextrow = 1 'starting row on destination worksheet
    Vendor = Array(12345, 11111, 22222, 33333, 44444) 'Find vendor number
    SearchSheets = Array("data", "employees", "hours worked", "monthly sales")
    For i = 0 To UBound(SearchSheets)
        With Sheets(SearchSheets(i))
            Set FindVend = .Range("H" & .Rows.Count).End(xlUp)
            For k = 0 To UBound(Vendor)
                For j = 1 To Application.WorksheetFunction.CountIf(.Columns(8), Vendor(k))
                    Set FindVend = .Range("H:H").Find(What:=Vendor(k), After:=FindVend, _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
                    If Not FindVend Is Nothing Then
                        FindVend.EntireRow.Copy _
                        Destination:=wsDest.Rows(Nextrow)
                        Nextrow = Nextrow + 1
                    End If
                Next j
            Next k
        End With
    Next i
End Sub