Create a summary list

[Av8tordude]

Can anyone help me with a VBA code that will take this list and create a summary list in column W-Y. Each item should have a subtotal like in the example in the next table. The Ticker and Name are in column A & B and the Amounts are in column P. The output should be place in in C.

Greatly appreciate i anyone could offer your assistance. Thank you kindly.


[TABLE="width: 409"]
<tbody>[TR]
[TD]Ticker[/TD]
[TD] Name[/TD]
[TD]Amount[/TD]
[/TR]
</tbody>[/TABLE]

[TABLE="width: 409"]
<tbody>[TR]
[TD]BA[/TD]
[TD]The Boeing Company[/TD]
[TD] $(617.90)[/TD]
[/TR]
[TR]
[TD]AAPL[/TD]
[TD]Apple Inc.[/TD]
[TD] $(118.67)[/TD]
[/TR]
[TR]
[TD]AAPL[/TD]
[TD]Apple Inc.[/TD]
[TD] $ 131.34[/TD]
[/TR]
[TR]
[TD]AAPL[/TD]
[TD]Apple Inc.[/TD]
[TD]$(238.07)[/TD]
[/TR]
[TR]
[TD]BA[/TD]
[TD]The Boeing Company[/TD]
[TD] $(374.06)[/TD]
[/TR]
[TR]
[TD]BA[/TD]
[TD]The Boeing Company[/TD]
[TD] $(101.09)[/TD]
[/TR]
[TR]
[TD]BA[/TD]
[TD]The Boeing Company[/TD]
[TD] $ 36.92[/TD]
[/TR]
[TR]
[TD]SPY[/TD]
[TD]SPDR S&P 500 ETF[/TD]
[TD] $ 304.10[/TD]
[/TR]
[TR]
[TD]AAPL[/TD]
[TD]Apple Inc.[/TD]
[TD] $(538.29)[/TD]
[/TR]
[TR]
[TD]SPY[/TD]
[TD]SPDR S&P 500 ETF[/TD]
[TD] $ 274.10[/TD]
[/TR]
[TR]
[TD]SQ[/TD]
[TD]Square[/TD]
[TD] $ 466.71[/TD]
[/TR]
[TR]
[TD]AAPL[/TD]
[TD]Apple Inc.[/TD]
[TD] $ 87.77[/TD]
[/TR]
[TR]
[TD]IBM[/TD]
[TD]International Business Machines Corporation[/TD]
[TD] $ 262.10[/TD]
[/TR]
[TR]
[TD]NVDA[/TD]
[TD]NVIDIA Corporation[/TD]
[TD] $ 708.93[/TD]
[/TR]
[TR]
[TD]SPY[/TD]
[TD]SPDR S&P 500 ETF[/TD]
[TD] $ 286.69[/TD]
[/TR]
[TR]
[TD]BA[/TD]
[TD]The Boeing Company[/TD]
[TD] $ 933.90[/TD]
[/TR]
</tbody>[/TABLE]



[TABLE="width: 409"]
<tbody>[TR]
[TD]icker[/TD]
[TD]Name[/TD]
[TD]Total[/TD]
[/TR]
</tbody>[/TABLE]

[TABLE="width: 409"]
<tbody>[TR]
[TD]AAPL[/TD]
[TD]Apple Inc.[/TD]
[TD]$($657.92)[/TD]
[/TR]
[TR]
[TD]BA[/TD]
[TD]The Boeing Company[/TD]
[TD]$(122.23)[/TD]
[/TR]
[TR]
[TD]IBM[/TD]
[TD]International Business Machines Corporation[/TD]
[TD]$262.10[/TD]
[/TR]
[TR]
[TD]NVDA[/TD]
[TD]NVIDIA Corporation[/TD]
[TD]$708.93[/TD]
[/TR]
[TR]
[TD]SPY[/TD]
[TD]SPDR S&P 500 ETF[/TD]
[TD]$(864.89)[/TD]
[/TR]
[TR]
[TD]SQ[/TD]
[TD]Square[/TD]
[TD]$466.71[/TD]
[/TR]
</tbody>[/TABLE]

 

[Michael M]

A little confusing you say create the Summary list in Cols "W:Y"
Then you say

The output should be place in in C.

 

[Av8tordude]

Sorry about the confusion....Not sure why that happen. The output should be in column W-Y

A little confusing you say create the Summary list in Cols "W:Y"
Then you say

 

[Michael M]

Ok, is the data sorted ?

 

[Av8tordude]

No the data is not sorted

Ok, is the data sorted ?

 

[Michael M]

This if the data is not sorted !!

Sub MM1()
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "a").End(xlUp).Row
Range("A2:B" & lr & ",P2:P" & lr).Copy Range("W2")
    Range("X2").Select
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("X1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet2").Sort
        .SetRange Range("W2:Y" & lr)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
For r = lr To 2 Step -1
    If Cells(r, 24).Value = Cells(r - 1, 24).Value Then
        Cells(r - 1, 25).Value = Cells(r, 25).Value + Cells(r - 1, 25).Value
        Range(Cells(r, 23), Cells(r, 25)).Delete
    End If
Next r
End Sub

 

[Av8tordude]

I tried the code however, it does not take filter out unique names and total each unique name as in my example

 

[Michael M]

Hmm, works fine for me...is the sheet in question the activesheet ?
In the code the active sheet is "Sheet2", you may need to change that to suit whatever sheetname you are using

ActiveWorkbook.Worksheets([color=red]"Sheet2"[/color]).Sort.SortFields.Add Key:=Range("X1"), _

 

[Av8tordude]

I tried the code, but the math is not correct for the first row output. It shows 617.90, when it suppose to be 657.92. The rest looks like it achieves the task.

 

[Michael M]

Apple ince being the first compnay on the list, should be $-675.92, which agrees with col P AND col Y

Sub MM1()
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
Range("A2:B" & lr & ",P2:P" & lr).Copy Range("W2")
    Range("X2").Select
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("X2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.activesheet.Sort
        .SetRange Range("W2:Y" & lr)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
For r = lr To 2 Step -1
    If Cells(r, 24).Value = Cells(r - 1, 24).Value Then
        Cells(r - 1, 25).Value = Cells(r, 25).Value + Cells(r - 1, 25).Value
        Range(Cells(r, 23), Cells(r, 25)).Delete
    End If
Next r
End Sub