Consolidating Data from multiple tabs to a single tab; then based on variable

[briley]

Thank you for your time. This is my second post and I've learned so much from reading through all of your other responses. THANK YOU for passing along the knowledge and teaching us in the process

Here's my issue:

- I have a workbook with 15 sheets.
- The data from 9 of those sheets (Sheets 5-13) needs to be consolidated into one. (Sheet 2 "CONSOLIDATION - Team")
- The data on those 9 sheets is positioned from A3 to I3 with the number of rows varying by sheet, but month.
- All of the data is fielded uniformly from sheet to sheet and would like to keep it that way (so pasting Values only).

I'm trying to build a single macro that I can assign to a button on the CONSOLIDATION - Team sheet.

With all the searching I done, I would have thought I could find out how to do this one, but they all have variations that I haven't been able to muddle through.

___________________________________

Once I have the CONSOLIDATION - Team sheet, I then need to parse the data a bit further

- On another of the 15 sheets (Sheet 1 "CONSOLIDATION - Overview"), I need to pull in specific columns of information from the CONSOLIDATION - Team sheet based on a variable in column C
- On rows with column C = "Green", copy data in columns A, F and I and paste onto CONSOLIDATION - Overview starting in F5, then continuing down how ever many rows there is data.
- On rows with column C = "Blue", copy data in columns A, F and H and paste onto CONSOLIDATION - Overview starting in J5, then continuing down how ever many rows there is data.

Easy right?????

Thanks in advance for anyone's help.

 

[briley]

Run-time error '1004', Application-defined or object-defined error.
Debug highlights:
.Range("A3", Sheets("CONSOLIDATED - Team").Cells(Rows.Count, i).End(xlUp)).AutoFilter 3, "clrAry(i)"

 

[JLGWhiz]

I broke down and set up a test model to work the kinks out. The code below should run without error.

Sub CONSOLIDATE_Team()
 Dim U1 As Range, U2 As Range, lr As Long, clrAry As Variant
    For i = 5 To 13
        Sheets(i).Range("A3", Sheets(i).Cells(Rows.Count, "I").End(xlUp)).Copy
        Sheets("CONSOLIDATED - Team").Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial xlPasteValues
    Next
    With Sheets("CONSOLIDATED - Team")
        lr = .Cells.Find("*", , xlFormulas, xlPart, xlByRows, xlPrevious).Row
        .Cells.UnMerge
        clrAry = Array("Green", "Yellow", "Red")
        Set U1 = Union(.Range("A4:A" & lr), .Range("F4:F" & lr), .Range("I4:I" & lr))
            For i = LBound(clrAry) To UBound(clrAry)
                .Range("A3", .Cells(Rows.Count, "I").End(xlUp)).AutoFilter 3, clrAry(i)
                If Sheets("CONSOLIDATED - Overview").Range("F5") = "" Then
                    U1.SpecialCells(xlCellTypeVisible).Copy Sheets("CONSOLIDATED - Overview").Range("F5")
                Else
                    U1.SpecialCells(xlCellTypeVisible).Copy Sheets("CONSOLIDATED - Overview").Cells(Rows.Count, "F").End(xlUp)(2)
                End If
            Next
        .AutoFilterMode = False
        .Range("A3", Sheets("CONSOLIDATED - Team").Cells(Rows.Count, i).End(xlUp)).AutoFilter 3, "Blue"
        Set U2 = Union(.Range("A4:A" & lr), .Range("E4:E" & lr), .Range("H4:H" & lr))
        U2.SpecialCells(xlCellTypeVisible).Copy Sheets("CONSOLIDATED - Overview").Range("J5")
        .AutoFilterMode = False
    End With
 End Sub

We have spent about enough time on this thread. If you have any more after thoughts, please start a new thread.
Regards, JLG

 

[briley]

Thanks for your patience and help.
Still getting errors, but I'll start a new thread tomorrow.
You've been a tremendous help - I'm very grateful.

 

[JLGWhiz]

Thanks for your patience and help.
Still getting errors, but I'll start a new thread tomorrow.
You've been a tremendous help - I'm very grateful.

Just to close this out, I set up a test model with 15 sheets and data in columns A:I with varying rows and Column C with the four colors randomly entered in sheets 5 -15. The code ran without error and pasted the contends of sheets 5 - 15 into sheets CONSOLIDATED - Team, then filtered the various colors and copied the specified ranges to sheets CONSOLIDATED - Overview. If you are still getting errors, then check your spelling, look for characters that should not be there, etc. The code is now doing what it is intended to do.
Regards, JLG

 

[JLGWhiz]

1) If I don't have at least 4 lines of data on each Sheet, the Consolidation pulls in the header. I'm sure it has to do with line counts in some way.

Workaround: I just put factious/dumb data in blank lines until I get to the fourth line

2) The reason the macro was stopping on my side was because it seems to be looking for Green, Yellow and Red to appear, and I had no Red (which is often the case).

Workaround: I put in a fictitious/dumb Red just to get the macro to finish. That's not ideal at all because we'll often not have Red, or even Yellow sometimes. Not sure how to truly fix this one.

I've only created one new problem through all my poking at your code. The CONSOLIDATED - Team is trying to pull in data from sheets beyond the defined parameter. It pulls data from sheet 19-21 too. Haven't figured that one out yet, but working on it.

For i = 5 To 18
Sheets(i).Range("A3", Sheets(i).Cells(Rows.Count, "I").End(xlUp)).Copy
Sheets("CONSOLIDATED - Team").Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial xlPasteValues

Per private message, I have added two If...Then shatements that should make your work arounds unnecessary. I did not test them, so you need to check them out.

Sub CONSOLIDATE_Team()
 Dim U1 As Range, U2 As Range, lr As Long, clrAry As Variant
    For i = 5 To 18
        If Application.CountA(Sheets(i).Range("3:3")) > 0 Then
            Sheets(i).Range("A3", Sheets(i).Cells(Rows.Count, "I").End(xlUp)).Copy
            Sheets("CONSOLIDATED - Team").Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial xlPasteValues
        End If
    Next
    With Sheets("CONSOLIDATED - Team")
        lr = .Cells.Find("*", , xlFormulas, xlPart, xlByRows, xlPrevious).Row
        .Cells.UnMerge
        clrAry = Array("Green", "Yellow", "Red")
        Set U1 = Union(.Range("A4:A" & lr), .Range("F4:F" & lr), .Range("I4:I" & lr))
            For i = LBound(clrAry) To UBound(clrAry)
                If Application.CountIf(.Range("C:C"), clrAry(i)) > 0 Then
                    .Range("A3", .Cells(Rows.Count, "I").End(xlUp)).AutoFilter 3, clrAry(i)
                        If Sheets("CONSOLIDATED - Overview").Range("F5") = "" Then
                            U1.SpecialCells(xlCellTypeVisible).Copy Sheets("CONSOLIDATED - Overview").Range("F5")
                        Else
                            U1.SpecialCells(xlCellTypeVisible).Copy Sheets("CONSOLIDATED - Overview").Cells(Rows.Count, "F").End(xlUp)(2)
                        End If
                End If
            Next
        .AutoFilterMode = False
        .Range("A3", Sheets("CONSOLIDATED - Team").Cells(Rows.Count, i).End(xlUp)).AutoFilter 3, "Blue"
        Set U2 = Union(.Range("A4:A" & lr), .Range("E4:E" & lr), .Range("H4:H" & lr))
        U2.SpecialCells(xlCellTypeVisible).Copy Sheets("CONSOLIDATED - Overview").Range("J5")
        .AutoFilterMode = False
    End With
 End Sub