I rewrote this in a longer form than jindon .. I don't have his knack for short-hand coding I guess! But you might find this easier to follow; I've basically split the data collection into 3 parts and commented in the code what it's doing.
Option Explicit
Option Base 1
Public Sub ConsolidateData()
Dim wks As Worksheet
Dim arrP As Variant
Dim i As Long, j As Long, k As Long
Dim arrR() As Variant, arrA() As Variant
Dim cel As Range, rng As Range, celP As Range, celR As Range, celA As Range
Const conFormula = "=EDATE($E1,COLUMN(A1)-1)"
Application.ScreenUpdating = False
Application.EnableEvents = False
With Sheet5
'clear out the consolidated data sheet:
Set rng = .UsedRange.Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
Set rng = rng.Offset(1, 0)
rng.ClearContents
'first cell of each data group in the consolidation sheet:
Set celP = .Range("A1") 'project name.
Set celR = .Range("1:1").Find(what:="Role", lookat:=xlWhole, LookIn:=xlValues) 'role.
Set celA = .Range("1:1").SpecialCells(xlCellTypeConstants, 1).Cells(1, 1) 'first number.
End With
'load the project, resource & allocation data from each project worksheet:
For Each wks In ThisWorkbook.Worksheets
If InStr(1, wks.Name, "Template", vbTextCompare) = 0 Then
Set cel = wks.Rows(3).Find(what:=conFormula, LookIn:=xlFormulas, lookat:=xlWhole)
If Not cel Is Nothing Then
'arrP = project data from the header:
ReDim arrP(4)
arrP(1) = wks.Range("B1").Value 'project name.
arrP(2) = wks.Range("E1").Value 'start date.
arrP(3) = wks.Range("G1").Value 'duration.
arrP(4) = wks.Range("K1").Value 'project manager.
'arrR = resource data - columns before the first date:
Set rng = wks.Range("A" & Rows.Count).End(xlUp)
Set rng = wks.Range(rng, cel.Offset(1, -1))
arrR() = rng.Value
'arrA = allocation data - column right of the first date:
Set rng = wks.Cells(cel.Row, Columns.Count).End(xlToLeft)
Set rng = wks.Range(cel.Offset(1, 0), rng.Offset(UBound(arrR), 0))
arrA() = rng.Value
'get first & last rows to write to:
i = Sheet5.Cells(Rows.Count, celP.Column).End(xlUp).Row + 1
j = i + UBound(arrR, 1) - 1
'write the data to the consolidation sheet:
'------------------------------------------
' - project data:
Set rng = Sheet5.Range(Sheet5.Cells(i, celP.Column), Sheet5.Cells(j, celP.Column + UBound(arrP) - 1))
rng.Rows(1).Value = arrP
rng.FillDown
' - resource data:
Set rng = rng.Offset(0, UBound(arrP))
Set rng = rng.Resize(rng.Rows.Count, UBound(arrR, 2))
rng.Value = arrR()
' - allocation data:
Set rng = rng.Offset(0, UBound(arrR, 2))
Set rng = rng.Resize(rng.Rows.Count, UBound(arrA, 2))
k = 0
Do While CDate(celA.Offset(0, k).Value) <> CDate(cel.Value)
k = k + 1
Loop
Set rng = rng.Offset(0, k)
rng.Value = arrA()
End If
End If
Next wks
GracefulExit:
Application.ScreenUpdating = True
Application.EnableEvents = True
Set arrP = Nothing
Set cel = Nothing: Set rng = Nothing
Set celP = Nothing: Set celR = Nothing: Set celA = Nothing
End Sub
It's in the attached workbook in the modMM module.
You'll just need to add a button or trigger it however you want to do that and there's some error-trapping to be done as well, such as for when a date isn't found and so on.
Hope that helps. MM.
Bookmarks