VBA to Populate summary sheet based on criteria in source sheets

[gmittar]

Hi All,

I’m trying to write a macro to populate a summary sheet. The Summary sheet lists rows from sheets in the same workbook, depending on a drop down box for each line in the source sheets. If the a specific cell on source sheet 1 says yes, that entire row is to be pasted into the summary sheet. This will need to be repeated for each row in source sheet 1, and then move on to source sheet 2 and so on.

I’m not good enough with VBA to write the loops to make this happen, so I’m hoping one of you can help me in the right direction.

I've attached a dummy file in the box link below, I appreciate any help.

https://sagehospitalityllc.box.com/s/51xt5mr0vkp6n63vlah0lpvb1u0rjmuc

 

[DanteAmor]

Try the following:

Sub Macro12()
'
' Populate summary sheet based on criteria in source sheets
'
    Application.ScreenUpdating = False
    Dim h1 As Worksheet, h2 As Worksheet
    Dim u1 As Double, u2 As Double
    
    Set h1 = Sheets("Reconciling Summary")
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    h1.Rows("9:" & Rows.Count).ClearContents
'
    For Each h2 In Sheets
        If h1.Name <> h2.Name Then
            If h2.AutoFilterMode Then h2.AutoFilterMode = False
            u2 = h2.Range("D" & Rows.Count).End(xlUp).Row
            h2.Range("A8:I" & u2).AutoFilter Field:=4, Criteria1:="Y"
            u2 = h2.Range("D" & Rows.Count).End(xlUp).Row
            h2.Range("A9:I" & u2).Copy
            u1 = h1.Range("D" & Rows.Count).End(xlUp).Row + 1
            h1.Range("A" & u1).PasteSpecial xlPasteValues
            h1.Range("A" & u1).PasteSpecial xlPasteFormats
            If h2.AutoFilterMode Then h2.AutoFilterMode = False
        End If
    Next
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "End"
End Sub

 

[vcoolio]

Hello Gmittar,

Here's another option for you. It's a Workbook_SheetChange event code. It doesn't require any buttons:-

Option Compare Text
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

If Intersect(Target, Sh.Range("D9", Sh.Range("D" & Sh.Rows.Count).End(xlUp))) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = vbNullString Then Exit Sub

Dim ws As Worksheet: Set ws = Sheets("Reconciling Summary")

Application.ScreenUpdating = False

If Sh.Name = "Reconciling Summary" Then Exit Sub
      If Target.Value = "Y" Then
      Sh.Range(Sh.Cells(Target.Row, "B"), Sh.Cells(Target.Row, "I")).Copy
      ws.Range("B" & Rows.Count).End(3)(2).PasteSpecial xlValues
End If

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Once you select "Y" from any data validation drop down boxes (or just type in "Y") from any cell in Column D of any source sheet, the relevant row of data will be transferred to the Reconciling Summary sheet.

To implement this code:-

- Open the VB Editor (press Alt + F11).
- Over in the Project Explorer, double click on ThisWorkbook.
- In the big white code field that then appears, paste the above code.

Please test this in a copy of your workbook first.

I hope that this helps.Cheerio,
vcoolio.

 

[gmittar]

Thank you both for your excellent solutions, they both work like a charm and give me good options to use for this project.

Very much appreciated!

 

[vcoolio]

You're welcome Gmittar and thanks for the feedback.

Cheerio,
vcoolio.