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

 

[Fluff]

That fixed it and it works perfectly! Thank you!

 

[Jmoz092]

@Jmoz092
One problem is

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

I'm sorry, I didn't realize that was happening. It must be an issue with copy and pasting from the Notes App on my Mac?? I changed up the code a bit (copied from the VBA window):

Sub Ordered()


    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 = 2 To 13
        With Sheets(cnt)
            UsdRws = .Range("M" & Rows.Count).End(xlUp).Row
            .Range("A2:M3").AutoFilter
            On Error Resume Next
            .Range("m3:M100" & UsdRws).AutoFilter field:=13, Criteria1:="Ordered"
            .Range("A3:M" & UsdRws).SpecialCells(xlVisible).Copy _
                Psht.Range("A" & Rows.Count).End(xlUp).Offset(1)
            .Range("M3:M100" & UsdRws).AutoFilter field:=13, Criteria1:="Yes"
            .Range("A3:M" & UsdRws).SpecialCells(xlVisible).Copy _
                Asht.Range("A" & Rows.Count).End(xlUp).Offset(1)
            On Error GoTo 0
            .Range("A2:M3").AutoFilter
        End With
    Next cnt
    
End Sub

The 1st sheet in this workbook is our current inventory that is updated upon opening this workbook, so I excluded that in the code. Thanks for the tip on the difference between 13 and 15 in this lines.

This runs well insofar that it is returning all entries throughout the workbook with "Ordered" and "Yes" in column M to the sheets titled the same...but, on the "Ordered" sheet, rows 2-9 and rows 12-14 are the heading row (that was originally line 2 in the blank "Ordered" sheet). I'm guessing that rows 2-9 and 12-14 are populated now by pulling row 2 from each month's tab and transposing it to the "Ordered" sheet?

Rows 10-11 do, however, display the workbook's entries for the rows that contain "ordered" in column M, so thats nice.

The "Yes" sheet is similar. Rows 2-9 and 29-31 are the header row. Rows 10-28 display all the workbook's entries that have "Yes" in column M.

Why did it do this?

 

[Fluff]

Not quite sure what you're on about. Remember I cannot see your monitor.
But see if this helps

Sub Ordered()


    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:M10000").Clear
    Asht.Range("A3:M10000").Clear
    
    For cnt = 2 To 13
        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:=13, Criteria1:="Ordered"
            .Range("A3:M" & UsdRws+1).SpecialCells(xlVisible).Copy _
                Psht.Range("A" & Rows.Count).End(xlUp).Offset(1)
            .Range("A2:M" & UsdRws).AutoFilter field:=13, Criteria1:="Yes"
            .Range("A3:M" & UsdRws+1).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

 

[Jmoz092]

Not quite sure what you're on about. Remember I cannot see your monitor.
But see if this helps

Sub Ordered()


    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:M10000").Clear
    Asht.Range("A3:M10000").Clear
    
    For cnt = 2 To 13
        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:=13, Criteria1:="Ordered"
            .Range("A3:M" & UsdRws+1).SpecialCells(xlVisible).Copy _
                Psht.Range("A" & Rows.Count).End(xlUp).Offset(1)
            .Range("A2:M" & UsdRws).AutoFilter field:=13, Criteria1:="Yes"
            .Range("A3:M" & UsdRws+1).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

Works perfectly. I'll dissect that to figure out what you altered and apply it to more scenarios in that workbook. 1000 thanks to @Fluff!

 

[Fluff]

@Jmoz092
Glad to help & thanks for the feedback.
As you are working on a Mac, I would also recommend that you start your own threads in future & if you feel the need you can always post a link to other threads.
There are somethings that can be done on a PC but not a Mac.
It also helps to avoid confusion.
Cheers