Q
QuietMan
Can anyone help with this?
Public Sub ConsolidationTest()
Dim wkb As Workbook
Dim wks As Worksheet
Dim Mth_Area As String
Dim Ytd_Area As String
Dim FX_Mth_Area As String
Dim FX_YTD_Area As String
Dim Q1_Area As String
Dim Q2_Area As String
Dim Q3_Area As String
Dim Q4_Area As String
Mth_Area = "R9C3:R62C14"
Ytd_Area = "R9C16:R61C36"
FX_Mth_Area = "R16C38:R62C44"
FX_YTD_Area = "R16C46:R62C52"
Q1_Area = "R9C54:R62C57"
Q2_Area = "R9C59:R62C62"
Q3_Area = "R9C64:R62C67"
Q4_Area = "R9C69:R62C77"
Set wkb = ThisWorkbook
Set wks = wkb.Sheets(1)
' Use following line of code to specify how to create your intended array
Call DoConsolidation(wkb, wks.Range("C9"), Mth_Area, _
Array("Sheet37", "Sheet33"))
Call DoConsolidation(wkb, wks.Range("P9"), Ytd_Area, _
Array("Sheet37", "Sheet33"))
Call DoConsolidation(wkb, wks.Range("AL16"), FX_Mth_Area, _
Array("Sheet37", "Sheet33"))
Call DoConsolidation(wkb, wks.Range("AT16"), FX_YTD_Area, _
Array("Sheet37", "Sheet33"))
Call DoConsolidation(wkb, wks.Range("BB9"), Q1_Area, _
Array("Sheet37", "Sheet33"))
Call DoConsolidation(wkb, wks.Range("BG9"), Q2_Area, _
Array("Sheet37", "Sheet33"))
Call DoConsolidation(wkb, wks.Range("BL"), Q3_Area, _
Array("Sheet37", "Sheet33"))
Call DoConsolidation(wkb, wks.Range("BQ"), Q4_Area, _
Array("Sheet37", "Sheet33"))
End Sub
Public Sub DoConsolidation(wkb As Workbook, rngConsolidation As Range, _
strArea As String, arrList As Variant)
Dim arrParam As Variant
Dim strElement As String
Dim lngCount As Long
Dim i As Long
lngCount = UBound(arrList) - LBound(arrList)
ReDim arrParam(0 To lngCount) As String
For i = 0 To lngCount
If (VarType(arrList(i)) = vbLong) Then
strElement = "'" & wkb.Path & "\[" & wkb.Name & "]" & _
wkb.Worksheets(Int(arrList(i))).Name & "'!" & strArea
Else
strElement = "'" & wkb.Path & "\[" & wkb.Name & "]" & _
wkb.Worksheets(arrList(i)).Name & "'!" & strArea
End If
arrParam(i) = strElement
Next i
rngConsolidation.Consolidate Sources:=arrParam, Function:=xlSum
End Sub
Public Sub ConsolidationTest()
Dim wkb As Workbook
Dim wks As Worksheet
Dim Mth_Area As String
Dim Ytd_Area As String
Dim FX_Mth_Area As String
Dim FX_YTD_Area As String
Dim Q1_Area As String
Dim Q2_Area As String
Dim Q3_Area As String
Dim Q4_Area As String
Mth_Area = "R9C3:R62C14"
Ytd_Area = "R9C16:R61C36"
FX_Mth_Area = "R16C38:R62C44"
FX_YTD_Area = "R16C46:R62C52"
Q1_Area = "R9C54:R62C57"
Q2_Area = "R9C59:R62C62"
Q3_Area = "R9C64:R62C67"
Q4_Area = "R9C69:R62C77"
Set wkb = ThisWorkbook
Set wks = wkb.Sheets(1)
' Use following line of code to specify how to create your intended array
Call DoConsolidation(wkb, wks.Range("C9"), Mth_Area, _
Array("Sheet37", "Sheet33"))
Call DoConsolidation(wkb, wks.Range("P9"), Ytd_Area, _
Array("Sheet37", "Sheet33"))
Call DoConsolidation(wkb, wks.Range("AL16"), FX_Mth_Area, _
Array("Sheet37", "Sheet33"))
Call DoConsolidation(wkb, wks.Range("AT16"), FX_YTD_Area, _
Array("Sheet37", "Sheet33"))
Call DoConsolidation(wkb, wks.Range("BB9"), Q1_Area, _
Array("Sheet37", "Sheet33"))
Call DoConsolidation(wkb, wks.Range("BG9"), Q2_Area, _
Array("Sheet37", "Sheet33"))
Call DoConsolidation(wkb, wks.Range("BL"), Q3_Area, _
Array("Sheet37", "Sheet33"))
Call DoConsolidation(wkb, wks.Range("BQ"), Q4_Area, _
Array("Sheet37", "Sheet33"))
End Sub
Public Sub DoConsolidation(wkb As Workbook, rngConsolidation As Range, _
strArea As String, arrList As Variant)
Dim arrParam As Variant
Dim strElement As String
Dim lngCount As Long
Dim i As Long
lngCount = UBound(arrList) - LBound(arrList)
ReDim arrParam(0 To lngCount) As String
For i = 0 To lngCount
If (VarType(arrList(i)) = vbLong) Then
strElement = "'" & wkb.Path & "\[" & wkb.Name & "]" & _
wkb.Worksheets(Int(arrList(i))).Name & "'!" & strArea
Else
strElement = "'" & wkb.Path & "\[" & wkb.Name & "]" & _
wkb.Worksheets(arrList(i)).Name & "'!" & strArea
End If
arrParam(i) = strElement
Next i
rngConsolidation.Consolidate Sources:=arrParam, Function:=xlSum
End Sub