How can I add cell values based on column header?-CodePudding

I am having trouble grasping how the operation I'm about to describe can be conceptualized, since I am new to coding.

A big spreadsheet includes 100 columns, and those need to be condensed down to 10 by adding together the columns. There is a key, so that all the columns tagged with "1" go to 1st new column, and so on.

Here is an example:

There are n original columns. Each one of those columns has a key (bottom left), and according to that key it must be added to column 1, 2, 3, or 4 of the new table (bottom right). This is all nice and clean but the real spreadsheet has perhaps 270 columns and they must be condensed into 10 columns or so for 3000 ID's where not all ID's have all columns filled.

I am not sure how to create that sort of loop, I thought of looping through the key first, then finding in the original columns each "A", adding them to first column of new table, then doing that through all of them, but I'm not sure how to avoid overwriting old sums with the new ones.

Cheers!

CodePudding user response：

You can do it with SUMPRODUCT. Actually, you can code it on VBA using this same formula of SUMPRODUCT and pasting values or with Evaluate:

=SUMPRODUCT(--($A$2:$A$6=$F14)*$B$2:$M$6*TRANSPOSE(--($B$14:$B$25=G$13)))

Depending on your Excel version maybe you need to input the formula as array formula, so instead of normally, type the formula and press CTRL ENTER SHIFT

UPDATE: You can also do it with VBA but you need to make some changes to your source file to make it work with any dataset of any size:

Your data must be alone in a worksheet called DATA
Your keys must be alone in a worksheet called KEYS

The code will generate a new worksheet with the grouped data according to keys. It uses same formula than before, but does it everything alone.

Sub TEST()
Dim wk As Worksheet
Dim rngData As Range
Dim rngKeys As Range
Dim LR As Long 'last non blank row
Dim LC As Long 'last non blank column
Dim ThisKeys As Variant



Set wk = ThisWorkbook.Sheets.Add(, ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)) 'add new worksheet for output at end of workbook

With ThisWorkbook.Worksheets("DATA")
    LR = .Range("A" & .Rows.Count).End(xlUp).Row
    LC = .Cells(1, .Columns.Count).End(xlToLeft).Column
    Set rngData = .Range(.Cells(2, 2), .Cells(LR, LC))
    .Range("A2:A" & LR).Copy wk.Range("A2:A" & LR) 'copy names to output
End With



With ThisWorkbook.Worksheets("KEYS")
    LR = .Range("A" & .Rows.Count).End(xlUp).Row
    Set rngKeys = .Range("B2:B" & LR)
    .Range("B2:B" & LR).Copy
    wk.Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
End With

With wk
    .Range("B2:B" & LR).RemoveDuplicates Columns:=1, Header:=xlNo
    LR = .Range("B" & .Rows.Count).End(xlUp).Row
    ThisKeys = .Range("B2:B" & LR).Value
    .Range("B2:B" & LR).Clear
    .Range("B1").Resize(1, UBound(ThisKeys)) = Application.WorksheetFunction.Transpose(ThisKeys) 'transpose keys to horizontal
    .Range("A1").Value = "Names / Keys"
    LR = .Range("A" & .Rows.Count).End(xlUp).Row
    LC = .Cells(1, .Columns.Count).End(xlToLeft).Column
    .Range("B2").FormulaArray = _
        "=SUMPRODUCT(--(DATA!R2C1:R" & rngData.Rows.Count   1 & "C1=RC1)*DATA!" & rngData.Address(True, True, xlR1C1) & "*TRANSPOSE(--(KEYS!R2C2:R" & rngKeys.Rows.Count   1 & "C2=R1C)))"
    .Range("B2").AutoFill Destination:=Range(.Range(.Cells(2, 2), .Cells(2, LC)).Address), Type:=xlFillDefault 'drag to right
    .Range(.Cells(2, 2), .Cells(2, LC)).AutoFill Destination:=Range(.Range(.Cells(2, 2), .Cells(LR, LC)).Address), Type:=xlFillDefault 'drag to right
    .Range(.Cells(2, 2), .Cells(LR, LC)).Value = .Range(.Cells(2, 2), .Cells(LR, LC)).Value 'paste as values, not formulas
    
End With



Erase ThisKeys
Set rngKeys = Nothing
Set rngData = Nothing
Set wk = Nothing

End Sub

I uploaded the file with the code so you can check it out: https://drive.google.com/file/d/1rc8oOPcqP4HBFEyamku24H9hHRFpncq_/view?usp=sharing