Grouping Column Names

[vba_hugo]

Hey all,

I'm new to this forum and relatively new to VBA. I'm currently working on a project and I'm trying to code the following, but I'm having difficulty.

My data is a static table. The first column it titled Year and goes from 2011 to 2015. The columns thereafter are titled with 6 digit codes which correspond to account numbers under which is an oustanding amount due each year (in $).

Basically, I'm trying to sum all codes that start with the same two digits for each year. I'm able to sum columns individually as such:

Sub sum_stuff()

Dim LR As Long
With Sheets("Static")
    LR = .Range("D" & Rows.Count).End(xlUp).Row
    .Range("D" & LR + 1).Value = WorksheetFunction.Sum(.Range("D1:D" & LR))
End With


End Sub

However I want to sum all codes that start with the same two digits for each year. Remember each row is a year and the columns represent account numbers. I know there's something about left function too... but not sure here.

Sorry if this is a lot to ask!

Thanks.

Best

 

[portews]

This will create a summary table 3 rows below the data rows. It will put the years in column A and the unique, 2 number codes as headers. It loops thru the data by year and account numbers. If the left 2 numbers of the column header for the selected cell matches the unique number in the summary header, it adds the selected cell to the appropriate year and unique cell in the summary table.

Sub acctSumByYear()
'http://www.mrexcel.com/forum/excel-questions/957034-grouping-column-names.html
Dim sht As Worksheet
Dim excludes() As Integer
Set sht = ActiveSheet
'LastRow is based on column A.  Change if this is not consistently the longest column
lastrow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1


LastColumn = sht.Cells(1, sht.Columns.Count).End(xlToLeft).Column


For uniqueRow = 2 To LastColumn
    Cells(lastrow + uniqueRow + 1, 1) = Left(Cells(1, uniqueRow), 2)
Next uniqueRow


ActiveSheet.Range(Cells(lastrow + 3, 1), Cells(lastrow + 1 + LastColumn, 1)).RemoveDuplicates Columns:=Array(1), Header:=xlNo


Range(Cells(lastrow + 3, 1), Cells(Cells(sht.Rows.Count, "A").End(xlUp).Row, 1)).Copy
Cells(lastrow + 3, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, Transpose:=True
Range(Cells(lastrow + 3, 1), Cells(Cells(sht.Rows.Count, "A").End(xlUp).Row, 1)).ClearContents


For sumyear = 2 To lastrow
'print the year
    Cells(lastrow + 2 + sumyear, 1) = Cells(sumyear, 1)
Next sumyear


'loop thru the years in the data
For y = 2 To lastrow - 1
    
    'loop thru the accounts in the data
    For i = 2 To LastColumn
                
        'look in the summary header row
        With sht.Range(Cells(lastrow + 3, 2), Cells(lastrow + 3, Cells(lastrow + 3, Columns.Count).End(xlToLeft).Column))
        'find the row in the summary header row that matches the two left characters of the current data column
        Set Rng = .Find(What:=Left(Trim(Cells(1, i)), 2), _
            After:=.Cells(.Cells.Count), _
            LookIn:=xlValues, _
            LookAt:=xlWhole, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=False)
        'if it finds a match
        If Not Rng Is Nothing Then
            'add the value in the current account for the year to the summary field for year and account
            Cells(lastrow + 2 + y, Rng.Column) = Cells(lastrow + 2 + y, Rng.Column) + Cells(y, i)
        End If
    End With
    
    Next i

Next y
End Sub