Please help me finish the last piece to this macro!

C

cjvenables

Board Regular
Joined
Aug 2, 2011
Messages
65
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
_________________
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Sort by date Sort by votes
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.
Code: 
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
 
Upvote 0
Okay, I think I have your code modified to work as you want.

Code: 
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
 
Last edited:
Upvote 0
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.
 
Upvote 0
djreiswig said:
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.
Click to expand...

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.
 
Upvote 0
Try this out. Searches across multiple sheets and for multiple vendor numbers.

Code: 
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
Extract and Merge Files
Replies
1
Views
78
rowebca
rowebca
sparky2205
  • Solved
Loop increment help required
Replies
3
Views
341
rlv01
R
T
  • Solved
Help with VBA Code in Excel
Replies
2
Views
268
tixarah
T
D
  • Question Question
Help with VB Code
Replies
2
Views
258
rlv01
R
B
  • Question Question
Pivot table: iterating through each item takes forever
Replies
2
Views
351
RoryA
RoryA

Forum statistics

Threads
1,223,247
Messages
6,171,007
Members
452,374
Latest member
keccles

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top