VBA Question - Search Multiple Sheets & Put Data in Summary Sheets

B

BradCh

New Member
Joined
Sep 19, 2017
Messages
10
I've been searching this for days and I've actually found a code that works for one sheet. I'm an amateur at Excel and a complete newbie at Visual...any help is greatly appreciated!

I have a workbook that has several tabs/worksheets for months (as well as a few for customers, etc) It's basically a construction bid log, if you're familiar with that. I would like to filter through the month sheets (the first 12 sheets) and copy/paste data to a summary sheet, based on the text in the "O" field. If it's "Pending", the row from A to Q would need to copy to the "PENDING" sheet. If the text in the "O" column is "Approved", then the row (From A to Q) would need to be copied to the "APPROVED" sheet. I don't want to delete the data in the other sheets, i just want it to compile in those summary sheets.

The "PENDING" and "APPROVED" sheets are identical to the monthly sheets. The title/row information takes up rows 1 & 2, so the copy from and the copy to would have to start at row 3 and fill in from there.

Can that all even be accomplished with one code or do I need two codes; one for "Pending" and one for "Approved"?

This is what my searching led me to: (it basically copies only the "Pending" to the "PENDING" sheet, but only for the "JAN" sheet...I tried adding the other sheets, but that didn't work.

Sub test()
Dim wsO As Worksheet, wsE As Worksheet
Dim LR As Long, i As Long
Set wsO = Sheets("PENDING")
Set wsE = Sheets("JAN")
LR = wsO.Cells(Rows.Count, 1).End(xlUp).Row
With wsE
For i = 2 To .Cells(Rows.Count, 15).End(xlUp).Row
If .Cells(i, 15).Value = "Pending" Then
.Rows(i).Copy wsO.Rows(LR + 1)
LR = LR + 1
End If
Next
End With
End Sub
 
Sort by date Sort by votes
Glad to help & thanks for the feedback
 
Upvote 0

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Hi Fluff, I have a similar issue in one of my excel projects. I need to search a workbook that has sheets titled as months in a year in column M for the word "Ordered" or "Yes". Then have the data (Columns A-M) transposed to the appropriate sheet. Each month's sheet is currently built to accept user data entry into rows 3-100, if that matters. I've tried to make adjustments to the code in this thread to suit my needs but I'm getting a error:

Compile error:variable not defined

The title of the sub is highlighted yellow and "Yes" in the set Asht line of code is highlighted blue. I'm trying to get all results for "Ordered" onto Psht, and all results for "Yes" onto Asht. What did I do wrong?

Code: 
Sub PendingOrders()


    Dim Psht As Worksheet
    Dim Asht As Worksheet
    Dim cnt As Long
    Dim UsdRws As Long
    
    Set Psht = Sheets("Ordered")
    Set Asht = Sheets(“Yes”)
    
    Psht.Range("a3:m50").Clear
    Asht.Range("a3:m250").Clear
    
    For cnt = 1 To 12
        With Sheets(cnt)
            UsdRws = .Range(“M” & Rows.Count).End(xlUp).Row
            .Range("A2:M2").AutoFilter
            On Error Resume Next
            .Range("A2:M" & UsdRws).AutoFilter field:=15, Criteria1:=“Ordered”
            .Range("A3:M" & UsdRws).SpecialCells(xlVisible).Copy _
                Psht.Range("A" & Rows.Count).End(xlUp).Offset(1)
            .Range("A2:M" & UsdRws).AutoFilter field:=15, Criteria1:="Yes"
            .Range("A3:M" & UsdRws).SpecialCells(xlVisible).Copy _
                Asht.Range("A" & Rows.Count).End(xlUp).Offset(1)
            On Error GoTo 0
            .Range("A2:M2").AutoFilter
        End With
    Next cnt
    
End Sub
 
Upvote 0
Looks like you've got the wrong type of quotes, in various places
ie
“Yes”
should be
"Yes"
 
Upvote 0
Fluff said:
Looks like you've got the wrong type of quotes, in various places
ie
“Yes”
should be
"Yes"
Click to expand...

Not sure why it came out like that. Here's the code I used:

Code: 
[COLOR=#454545][FONT=Helvetica Neue]Sub PendingOrders()[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]
[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]    Dim Psht As Worksheet[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]    Dim Asht As Worksheet[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]    Dim cnt As Long[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]    Dim UsdRws As Long[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]    [/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]    Set Psht = Sheets(“Ordered”)[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]    Set Asht = Sheets(“Yes”)[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]    [/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]    Psht.Range("A3:M50").Clear[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]    Asht.Range("A3:M360").Clear[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]    [/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]
[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]    For cnt = 1 To 12[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]        With Sheets(cnt)[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]            UsdRws = .Range(“M” & Rows.Count).End(xlUp).Row[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]            .Range("A2:M2").AutoFilter[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]            On Error Resume Next[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]            .Range("A2:M" & UsdRws).AutoFilter field:=15, Criteria1:=“Ordered”[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]            .Range("A3:M" & UsdRws).SpecialCells(xlVisible).Copy _[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]                Psht.Range("A" & Rows.Count).End(xlUp).Offset(1)[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]            .Range("A2:M" & UsdRws).AutoFilter field:=15, Criteria1:="Yes"[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]            .Range("A3:M" & UsdRws).SpecialCells(xlVisible).Copy _[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]                Asht.Range("A" & Rows.Count).End(xlUp).Offset(1)[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]            On Error GoTo 0[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]            .Range("A2:M2").AutoFilter[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]        End With[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]    Next cnt[/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]    [/FONT][/COLOR]
[COLOR=#454545][FONT=Helvetica Neue]End Sub[/FONT][/COLOR]

This is returning information to the "Ordered" and ""Yes" sheet, but the first 2 rows are the header information that I set the page up with, so that's good.
Rows 3-5 have data from my reference sheet, but only for columns A:E...don't know how that happened.
Then the even rows from 6-18 have the header row that is in row 2...not intended.
The odd rows from 7-17 have data pulled from varying month sheets (column A:M) that in no way match the criteria of "Ordered" or "Yes" in column M.
Then, rows 19-41 have data from varying month sheets (column A:M). Now, some of these have "Yes" or "Ordered" in column M.
Rows 42-43 are the header row data as in row 2
Row 44 is blank, but formatted the same as rows from the monthly sheets, in columns A:M

So this is a good start :rofl:
 
Upvote 0
Fluff said:
Glad to help & thanks for the feedback
Click to expand...

It's strange, but when I populate it with all of the bid information, it starts to copy the 4-rows into the summary pages again...I'm going to have to look and see if possibly one or more of the sheets is slightly different and causing that.
 
Upvote 0
@BradCh
The code is using col O to get the last row of data, so it maybe that it's giving a false reading.
try this
Code: 
Sub test()

    Dim Psht As Worksheet
    Dim Asht As Worksheet
    Dim cnt As Long
    Dim UsdRws As Long
    
    Set Psht = Sheets("PENDING")
    Set Asht = Sheets("APPROVED")
    
    Psht.Range("A3:Q63").Clear
    Asht.Range("A3:Q63").Clear
    
    For cnt = 1 To 12
        With Sheets(cnt)
            UsdRws = .Range("O" & Rows.Count).End(xlUp).Row
            Debug.Print UsdRws
'            .Range("A2:Q2").AutoFilter
'            On Error Resume Next
'            .Range("A2:Q" & UsdRws).AutoFilter field:=15, Criteria1:="Pending"
'            .Range("A3:Q" & UsdRws).SpecialCells(xlVisible).Copy _
'                Psht.Range("A" & Rows.Count).End(xlUp).Offset(1)
'            .Range("A2:Q" & UsdRws).AutoFilter field:=15, Criteria1:="Approved"
'            .Range("A3:Q" & UsdRws).SpecialCells(xlVisible).Copy _
'                Asht.Range("A" & Rows.Count).End(xlUp).Offset(1)
'            On Error GoTo 0
'            .Range("A2:Q2").AutoFilter
        End With
    Next cnt
    
End Sub
When it's run look in the immediate window (below the main code window Ctrl G will bring it up if needed) & check that the numbers given look ok. (ie nothing above 63)
 
Upvote 0
@Jmoz092
One problem is
Code: 
.Range("A2:M" & UsdRws).AutoFilter field:=15
Your setting the autofilter range to be Cols A to M & then filtering on Field 15 (ie Col O).
Also could you please not change the fonts, especially when posting code. The code in post#14 is virtually unreadable at my end.
 
Upvote 0
Fluff said:
@BradCh
The code is using col O to get the last row of data, so it maybe that it's giving a false reading.
try this
Code: 
Sub test()

    Dim Psht As Worksheet
    Dim Asht As Worksheet
    Dim cnt As Long
    Dim UsdRws As Long
    
    Set Psht = Sheets("PENDING")
    Set Asht = Sheets("APPROVED")
    
    Psht.Range("A3:Q63").Clear
    Asht.Range("A3:Q63").Clear
    
    For cnt = 1 To 12
        With Sheets(cnt)
            UsdRws = .Range("O" & Rows.Count).End(xlUp).Row
            Debug.Print UsdRws
'            .Range("A2:Q2").AutoFilter
'            On Error Resume Next
'            .Range("A2:Q" & UsdRws).AutoFilter field:=15, Criteria1:="Pending"
'            .Range("A3:Q" & UsdRws).SpecialCells(xlVisible).Copy _
'                Psht.Range("A" & Rows.Count).End(xlUp).Offset(1)
'            .Range("A2:Q" & UsdRws).AutoFilter field:=15, Criteria1:="Approved"
'            .Range("A3:Q" & UsdRws).SpecialCells(xlVisible).Copy _
'                Asht.Range("A" & Rows.Count).End(xlUp).Offset(1)
'            On Error GoTo 0
'            .Range("A2:Q2").AutoFilter
        End With
    Next cnt
    
End Sub
When it's run look in the immediate window (below the main code window Ctrl G will bring it up if needed) & check that the numbers given look ok. (ie nothing above 63)
Click to expand...

That one didn't work. It didn't give me an error, it just didn't copy paste everything. Below is a link to the actual (completely filled out spreadsheet), if you want to look at it. I don't want to keep that one up for too long.

By the way, what is the secret to running the macro without actually going to the developer tab, clicking macros, run, etc.? Also, if it's run after an update (marking something to "pending", for example), it duplicates everything in the summary sheets. Is there a way to only update? If not, no big deal; i can just delete the duplicates.

https://app.box.com/s/2cg1njxest8vqqvuas460a1e2jat9pg1
 
Last edited:
Upvote 0
OK try this
Code: 
Sub test()

    Dim Psht As Worksheet
    Dim Asht As Worksheet
    Dim cnt As Long
    Dim UsdRws As Long
    
    Set Psht = Sheets("PENDING")
    Set Asht = Sheets("APPROVED")
    
    Psht.Range("A3:[COLOR=#ff0000]Q10000[/COLOR]").Clear
    Asht.Range("A3:[COLOR=#ff0000]Q10000[/COLOR]").Clear
    
    For cnt = 1 To 12
        With Sheets(cnt)
            UsdRws = .Range("O" & Rows.Count).End(xlUp).Row
            .Range("A2:Q2").AutoFilter
            On Error Resume Next
            .Range("A2:Q" & UsdRws).AutoFilter field:=15, Criteria1:="Pending"
            .Range("A3:Q" & UsdRws + 1).SpecialCells(xlVisible).Copy _
                Psht.Range("A" & Rows.Count).End(xlUp).Offset(1)
            .Range("A2:Q" & UsdRws).AutoFilter field:=15, Criteria1:="Approved"
            .Range("A3:Q" & UsdRws + 1).SpecialCells(xlVisible).Copy _
                Asht.Range("A" & Rows.Count).End(xlUp).Offset(1)
            On Error GoTo 0
            .Range("A2:Q2").AutoFilter
        End With
    Next cnt
    
End Sub
Whilst in the code window, you can hit F5 to run the macro, or F8 which will run the macro 1 line at a time, which can help in debugging.
I've changed the 2 parts in red to clear the Pending & Approved sheets each time the macro runs. If you are ever likely to go over 10000 rows you'll need to increase these.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

U
  • Question Question
VBA Search Functionality Issue with Arabic Supplier Names in Excel Help Needed???
Replies
1
Views
41
Peter_SSs
Peter_SSs
V
  • Solved
Need VBA to split data into multiple sheets paste formulas, formatting AND data validation
Replies
2
Views
125
vanessavalentino83
V
A
  • Question Question
Assign Rows of Data to Employees from Master
Replies
9
Views
551
mumps
mumps
M
  • Question Question
Copy values from row to another sheet matched to todays date
Replies
1
Views
458
Herakles
H
J
  • Question Question
Using Sheets().Select in a Worksheet_Activate() macro
2
Replies
10
Views
475
jdun
J

Forum statistics

Threads
1,224,824
Messages
6,181,187
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

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