Consolidation Function

[MS_Xsmell]

Hello friends, I am using the consolidation function in excel to collect data from a number of worksheets. The code currently consolidates data on all tabs named 0,1,2,3,4,5,...."tab count" ("tabcount" representing the last tab name (currently at 50)).

I would like to update my code to only consolidate specific tabs in the range. In this case, I want to consolidate all tabs related to "Company 1" in the table below.

My current code follows:

Sub ConsolidateTabs()
 
Sheets("consl").Select

'Clear
    Sheets("Consl").Range("a1").Select
    Rows("1:165").Select
    Selection.ClearContents
    Sheets("Consl").Range("d10").Select

'Consolidated Sheets
  Dim i As Long, arr() As Variant

  ReDim arr(0 To Range("tabcount"))
  For i = 0 To UBound(arr)
    arr(i) = "'" & i & "'!R10C4:R160C240"
  Next
  Selection.Consolidate arr, xlSum, True, True, False


End Sub

Thank you!

 

[GWteB]

An update of your code like this could work. Note the use of a new procedure which is calling the updated one.

Sub ConsolidateByCompany()

    Call ConsolidateTabs(argWs:=Sheets("SheetWithTablePerAttachedImage"), _
                         argCy:="Company1")
End Sub


Sub ConsolidateTabs(ByRef argWs As Worksheet, ByVal argCy As String)
 
    Sheets("consl").Select

'Clear
    Sheets("Consl").Range("a1").Select
    Rows("1:165").Select
    Selection.ClearContents
    Sheets("Consl").Range("d10").Select

'Consolidated Sheets
    Dim i As Long, arr() As Variant

    Dim arrCy() As Variant
    Dim c       As Range
    With argWs
        For Each c In .Range("C3", .Cells(.Rows.Count, "C").End(xlUp))
            If StrComp(c.Value, argCy, vbTextCompare) = 0 Then
                ReDim Preserve arrCy(i)
                arrCy(i) = c.Offset(, -1).Value
                i = i + 1
            End If
        Next c
    End With

    ReDim arr(0 To UBound(arrCy))
    For i = 0 To UBound(arr)
        arr(i) = "'" & arrCy(i) & "'!R10C4:R160C240"
    Next
    Selection.Consolidate arr, xlSum, True, True, False
End Sub