How to combine reverse-chronological sheets while rearranging cells, preventing stacking? - vba

Question

OK, I will try to explain this well. An odd problem to solve, and it's WAY beyond my skill level (novice).
Excel 2011 for Mac.
The workbook has 11 sheets.
Sheet names are all 'Month Year'. (Eg: sheet 1 is titled "June 2013")
Sheet names are reverse chronological. (June 2013, May 2013, April 2013 etc)
Each sheet has data in the same layout:
A1 is the sheet's name. B1 through to a varying endpoint on B hold dates. (approx two weeks but varies greatly between sheets)
A2 and downward in A is all names, as "last,first".
The remaining columns below B1 and outward are either blank, 0's, or 1's (attendance for date at row 1).
What I need to do:
Get ALL of the data in one sheet, with dates in chronological order along row 1 and names in alphabetical order down column A. Without messing up the associations between the names and the 0/1/blank values that existed on the original sheet.
What I have done:
I did this manually using the Excel GUI on a very similar sheet. It took forever!
I also have been writing or sourcing Subs to do some of the other work needed to these sheets to get them ready for this big rearranging. But I am already at my limits writing super simple "find rows with the word 'total' in them" sorts of stuff.
I know WHAT to do here, but have no clue HOW.
Start with the oldest sheet, copy into a new sheet(YearSheet).
Take names from 2ndOldest, paste into A under names already there.
Take dates and the cells beneath them into YearSheet, but staggered out on the columns so they begin where the first sheet left off.
Repeat again with nextYoungest, same deal. Names under names, dates and data shoved out along the letter axis to prevent overlap with prior dates.
Eventually it's a long list of names in A, and a descending step-pattern of data blocks in the remainder.
Sort it all by A, alphabetically.
Find and compress identical names into one row, without losing the data along the way (Why does Excel only keep top left? Aaargh!)
So, I know that's a lot to ask here.
Have no idea if this is too much or over the top for a question, but I am just stumped so am posting it in hopes somebody can make sense of the VBA to do it.

Answer 1

I created a workbook based on your description to use as sample data.
I wrote this macro
Sub Main()
Dim CombinedData As Variant
Dim TotalCols As Integer
Dim TotalRows As Long
Dim PasteCol As Integer
Dim PasteRow As Long
Dim i As Integer
Dim PivSheet As Worksheet
ThisWorkbook.Sheets.Add Sheet1
On Error GoTo SheetExists
ActiveSheet.Name = "Combined"
On Error GoTo 0
Range("A1").Value = "Name"
For i = ThisWorkbook.Sheets.Count To 1 Step -1
If Sheets(i).Name <> "Combined" Then
Sheets(i).Select
TotalCols = Sheets(i).Columns(Columns.Count).End(xlToLeft).Column
TotalRows = Sheets(i).Rows(Rows.Count).End(xlUp).Row
PasteCol = PasteCol + TotalCols - 1
If PasteRow = 0 Then
PasteRow = 2
Else
PasteRow = PasteRow + TotalRows - 1
End If
'Copy Date Headers
Range(Cells(1, 2), Cells(1, TotalCols)).Copy Destination:=Sheets("Combined").Cells(1, PasteCol)
'Copy Names
Range(Cells(2, 1), Cells(TotalRows, 1)).Copy Destination:=Sheets("Combined").Cells(PasteRow, 1)
'Copy Data
Range(Cells(2, 2), Cells(TotalRows, TotalCols)).Copy Destination:=Sheets("Combined").Cells(PasteRow, PasteCol)
End If
Next
Sheets("Combined").Select
ActiveSheet.Columns.AutoFit
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A1"), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
.SetRange ActiveSheet.UsedRange
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Set PivSheet = Sheets.Add
ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=Sheets("Combined").UsedRange, _
Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:=PivSheet.Range("A1"), _
TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion14
For i = 1 To PivSheet.PivotTables("PivotTable1").PivotFields.Count
With ActiveSheet.PivotTables("PivotTable1")
If i = 1 Then
.PivotFields(i).Orientation = xlRowField
.PivotFields(i).Position = 1
Else
ActiveSheet.PivotTables("PivotTable1").AddDataField .PivotFields(i), _
"Sum of " & .PivotFields(i).Name, _
xlSum
End If
End With
Next
Application.DisplayAlerts = False
Sheets("Combined").Delete
Application.DisplayAlerts = True
PivSheet.Name = "Combined"
CombinedData = ActiveSheet.UsedRange
Cells.Delete
Range(Cells(1, 1), Cells(UBound(CombinedData), UBound(CombinedData, 2))).Value = CombinedData
Range("A1").Value = "Name"
Range(Cells(1, 1), Cells(1, UBound(CombinedData, 2))).Replace "Sum of ", ""
Columns.AutoFit
Exit Sub
SheetExists:
Application.DisplayAlerts = False
Sheets("Combined").Delete
Application.DisplayAlerts = True
Resume
End Sub
Which produces this result:
This was written in Excel 2010 in windows. I don't know what the differences are between the pc and mac versions but this may work for you.