Solved: Worksheet Consolidation of Rows that Meet Certain Criteria

[rballani]

I'm new here so please bear with me :hi:

I have looked through pages and pages of the forums and several of the KB articles and have found some examples that come close to giving me what I am trying to accomplish but not quite there. As it turns out that my knowledge of VBA (and coding in general) has been totally lost in the years I've been out of undergrad and I'm not having much luck manipulating the examples to work for me.

I am trying to consolidate data from several worksheets into a master worksheet but I only want to bring over the rows that meet certain criteria. I've been trying for hours to get this to work with IF statements or VLOOKUPs and can accomplish it to a degree but not quite what I am looking for and I'm hoping that someone has seen this before and can help me out.

I have attached an example workbook that has several worksheets. Pipeline is the "master" sheet that has the formatting in terms of division of data and ultimately what I'm trying to emulate with a formula or macro. The pipeline sheet is a combination of the sales persons worksheets (Burnett, Esper, Stepanik) for rows that have an 'x' in column B.

Sheet 1 is the closest I have gotten with some If statements to pulling the data from the sale's persons worksheets but to make sure I account for X number of clients/sales person there are many blank rows between the records and also because some records don't have the 'x' in column B.

Thanks in advance to anyone that might be able to help out someone who can't seem to recall any of that VBA from school : pray2:

[rballani]

Figured out a solution and it turned out to be much more simple than I was making it. Here is the macro in case anyone is interested in leveraging it for other spreadsheets:


Sub Aggregate()
Dim wks As Worksheet
Dim swks As Worksheet
Dim rng1 As Range
Dim rng1a As Range
Dim wkb As Workbook
Dim i As Integer

On Error GoTo Handler

Set wkb = ActiveWorkbook
Set swks = wkb.Worksheets("pipeline")
i = 0

swks.Range("A4:Z" & swks.Range("A65536").End(xlUp).Row).Clear

For Each wks In wkb.Worksheets
If wks.Name <> "key" And wks.Name <> "prospects" Then
Set rng1 = wks.Range("B4:B" & wks.Range("A65536").End(xlUp).Row)
For Each rng1a In rng1
If LCase(rng1a.Value) = "x" Then
rng1a.EntireRow.Copy
swks.Range("A4").Offset(i, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
i = i + 1
End If
Next rng1a
End If
Next wks

swks.Range("B4:B" & swks.Range("A65536").End(xlUp).Row).Clear
swks.Range("C4:AA" & swks.Range("A65536").End(xlUp).Row).Copy
swks.Range("B4").PasteSpecial xlPasteValues
Application.CutCopyMode = False

Exit Sub
Handler:

MsgBox "An unknown error occurred.", vbCritical, "Error"

End Sub