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

[BradCh]

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

 

[BradCh]

Below is a link to the sheet, for reference:
https://app.box.com/s/m25sgvanbyed5c1f8ura8yg36586olkh

 

[BradCh]

This must be more difficult than I thought...

 

[BradCh]

one last shot

 

[Fluff]

Hi & welcome to the board
Could you please repost your file, with some sample data in it?

 

[BradCh]

Hi & welcome to the board
Could you please repost your file, with some sample data in it?

Absolutely! Here's a link:
https://app.box.com/s/o7k8uu9yq9tme0oa1ewo8dq506jz9cjm

I only included a few sample lines in the "JAN" sheet, but they would be identical across all sheets. I marked one as "Pending" and one as "Approved". I would like the one marked "Pending" to automatically copy/paste to the "PENDING" sheet and the one marked "Approved" to automatically copy/paste to the "APPROVED" sheet. (hopefully without making duplicates) Also, if possible, to update when that field changes. For example, if the "Pending" label was changed to "Approved" (in the month it was bid), it would be copy/pasted into "APPROVED" and deleted from "PENDING" and if the "Pending" label were removed altogether, the data would be deleted from the "PENDING" page. If that's not possible, it's not a big deal.

 

[Fluff]

This should do what you originally asked. It will also clear both Pending & approved sheets first

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
            .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

I'll have a look at your new requests, when I get some time.

 

[BradCh]

This should do what you originally asked. It will also clear both Pending & approved sheets first

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
            .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

I'll have a look at your new requests, when I get some time.

That is nearly perfect! Thank you!!!! The only problem that it seems to have is that it copies the (4) heading rows at the bottom of each of the summary pages. (PENDING & APPROVED)

 

[Fluff]

If you mean these

Excel 2013 32 bit
	E	F
64	Amount Bid this Month:	$0
65	Amount Awarded Thus Far:	$0
66	Hit Ratio	FALSE
68
69
70		#DIV/0!
JAN

It's not happening for me. Is there a difference between the file you uploaded & the one you're testing on?

 

[BradCh]

You're right, it does work perfectly! I closed it, reopened it, and tested it again, and it didn't add those title rows at the bottom. I'm not sure what happened. Thank you again!