![]()
Sub summarize() Set sh1 = Sheets("Holdings") Set sh2 = Sheets("Report") cls = "A B C D E F G H I J K L M N O P Q R S T U V W X Y ZAAABACADAEAFAGAHAIAJAKALAMANAOAPAQARASATAUAVAWAXAYAZ" r2min = 6 c2min = 3 r1 = 6 r2 = r2min c2 = c2min tr = r2min - 2 sh2.Range("A:aa").ClearContents r1max = sh1.Range("A" & Rows.Count).End(xlUp).Row While r1 <= r1max ky = sh1.Cells(r1, "O") If ky = "" Then ky = "(blank)" Set rw = sh2.Range("B:B").Find(ky, LookIn:=xlValues) If rw Is Nothing Then rx = r2 sh2.Cells(rx, "B") = ky r2 = r2 + 1 Else rx = rw.Row End If ky = sh1.Cells(r1, "A") Set cl = sh2.Range(tr & ":" & tr).Find(ky, LookIn:=xlValues) If cl Is Nothing Then cx = c2 sh2.Cells(tr, cx) = ky c2 = c2 + 1 Else cx = cl.Column End If sh2.Cells(rx, cx) = sh2.Cells(rx, cx) + sh1.Cells(r1, "G") r1 = r1 + 1 Wend For rx = r2min To r2 - 1 For cx = c2min To c2 - 1 sh2.Cells(rx, c2) = sh2.Cells(rx, c2) + sh2.Cells(rx, cx) sh2.Cells(r2 + 1, cx) = sh2.Cells(r2 + 1, cx) + sh2.Cells(rx, cx) sh2.Cells(r2 + 1, c2) = sh2.Cells(r2 + 1, c2) + sh2.Cells(rx, cx) Next cx Next rx cn = Trim(Mid(cls, c2 * 2 - 2, 2)) sh2.Cells(tr, c2) = "Grand Total" sh2.Cells(r2 + 1, c2min - 1) = "Grand Total" Range("B" & r2min - 2 & ":" & cn & r2min - 2).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent1 .TintAndShade = 0.399975585192419 .PatternTintAndShade = 0 End With Range("B" & r2 + 1 & ":" & cn & r2 + 1).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent1 .TintAndShade = 0.399975585192419 .PatternTintAndShade = 0 End With Columns("B:" & cn).EntireColumn.AutoFit With ActiveWorkbook.Worksheets("Report").Sort .SortFields.Clear .SortFields.Add Key:=Range("B" & r2min & ":B" & r2 - 1) _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange Range("B" & r2min & ":" & cn & r2 - 1) .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub
Bookmarks