Create a summary list

Av8tordude

Well-known Member
Joined
Oct 13, 2007
Messages
1,075
Office Version
  1. 2019
Platform
  1. Windows
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]
 
BTW
Your sample data suggest the headings are in row 1 and the data starts in row 2...if that isn't the case, you will nedd to advise where the data actually sits
 
Upvote 0

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Please forgive me.... The first BA value in the top table is 617.90, however the BA subtotal should be ($122.23). The rest seems to be calculating correctly

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



This is the output it gave me....


[TABLE="width: 422"]
<tbody>[TR]
[TD]BA[/TD]
[TD]The Boeing Company[/TD]
[TD="align: right"]($617.90)[/TD]
[/TR]
[TR]
[TD]AAPL[/TD]
[TD]Apple Inc.[/TD]
[TD="align: right"]($675.92)[/TD]
[/TR]
[TR]
[TD]IBM[/TD]
[TD]International Business Machines Corporation[/TD]
[TD="align: right"]$262.10[/TD]
[/TR]
[TR]
[TD]NVDA[/TD]
[TD]NVIDIA Corporation[/TD]
[TD="align: right"]$708.93[/TD]
[/TR]
[TR]
[TD]SPY[/TD]
[TD]SPDR S&P 500 ETF[/TD]
[TD="align: right"]$864.89[/TD]
[/TR]
[TR]
[TD]SQ[/TD]
[TD]Square[/TD]
[TD="align: right"]$466.71[/TD]
[/TR]
[TR]
[TD]BA[/TD]
[TD]The Boeing Company[/TD]
[TD="align: right"]$495.67[/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:
Upvote 0
however the BA subtotal should be 1056.13.
How do you calculate that? The BA values are ..
($617.90)
($374.06)
($101.09)
$36.92
$933.90
.. which to me totals -122.23

Edit: Ignore above as I see you have edited your post. :)

Here is another approach
Code:
Sub Build_Table()
  Dim rData As Range
  
  Set rData = Range("A1", Range("B" & Rows.Count).End(xlUp))
  rData.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("W1"), Unique:=True
  With Range("W1").CurrentRegion
    .Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlYes
    .Columns(3).Formula = "=SUMIF(" & rData.Columns(1).Address & ",W1," & rData.Columns(3).Address & ")"
    .Cells(1, 3).Value = "Total"
    .Columns.AutoFit
  End With
End Sub
 
Last edited:
Upvote 0
Hmm, I don't understand why you would have 2 "Boeing" lines, it doesn't do that for me ??
and if you combine both Boeing lines you get $-122.23, which is what my code provides.
I'd suggest checking the spelling of ALL Boeing lines and also check for leading / trailling spaces, etc
 
Upvote 0
This worked out great Peter. Thank you kindly for your assistance.

How do you calculate that? The BA values are ..
($617.90)
($374.06)
($101.09)
$36.92
$933.90
.. which to me totals -122.23

Edit: Ignore above as I see you have edited your post. :)

Here is another approach
Code:
Sub Build_Table()
  Dim rData As Range
  
  Set rData = Range("A1", Range("B" & Rows.Count).End(xlUp))
  rData.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("W1"), Unique:=True
  With Range("W1").CurrentRegion
    .Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlYes
    .Columns(3).Formula = "=SUMIF(" & rData.Columns(1).Address & ",W1," & rData.Columns(3).Address & ")"
    .Cells(1, 3).Value = "Total"
    .Columns.AutoFit
  End With
End Sub
 
Upvote 0
I found something strange in the first BA. When I sorted the first table from A-Z, it did not sort the first BA, but all other BA were sorted. I will try to figure out why and post back.


Hmm, I don't understand why you would have 2 "Boeing" lines, it doesn't do that for me ??
and if you combine both Boeing lines you get $-122.23, which is what my code provides.
I'd suggest checking the spelling of ALL Boeing lines and also check for leading / trailling spaces, etc
 
Upvote 0
Just out of curiousity, my workbook is 99% VBA. Is there anyway to avoid inserting forumlas into the worksheet with this part of the code? Also, is there a way to insert a number count next to the Company name to indicate the number of times the name has been found i.e. Apple, Inc (12) ?

Code:
[COLOR=#333333].Columns(3).Formula = "=SUMIF(" & rData.Columns(1).Address & ",W1," & rData.Columns(3).Address & ")"[/COLOR]
 
Last edited:
Upvote 0
Just out of curiousity, my workbook is 99% VBA. Is there anyway to avoid inserting forumlas into the worksheet with this part of the code? Also, is there a way to insert a number count next to the Company name to indicate the number of times the name has been found i.e. Apple, Inc (12) ?

Code:
[COLOR=#333333].Columns(3).Formula = "=SUMIF(" & rData.Columns(1).Address & ",W1," & rData.Columns(3).Address & ")"[/COLOR]
Would this be sufficient?
Rich (BB code):
Sub Build_Table_v2()
  Dim rData As Range
  
  Set rData = Range("A1", Range("B" & Rows.Count).End(xlUp))
  rData.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("W1"), Unique:=True
  With Range("W1").CurrentRegion
    .Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlYes
    .Columns(3).Formula = "=X1 & "" ("" & countif(" & rData.Columns(2).Address & ",X1)  & "")"""
    .Columns(4).Formula = "=SUMIF(" & rData.Columns(1).Address & ",W1," & rData.Columns(3).Address & ")"
    With .Resize(, 4)
      .Value = .Value
      .Cells(1, 3).Resize(, 2).Value = Array("Name", "Total")
      .Columns(2).Delete
      .Columns.AutoFit
    End With
  End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,275
Messages
6,171,119
Members
452,381
Latest member
Nova88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top