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.

Ticker

Name

Amount

<tbody>
</tbody>

BA	The Boeing Company	$(617.90)
AAPL	Apple Inc.	$(118.67)
AAPL	Apple Inc.	$ 131.34
AAPL	Apple Inc.	$(238.07)
BA	The Boeing Company	$(374.06)
BA	The Boeing Company	$(101.09)
BA	The Boeing Company	$ 36.92
SPY	SPDR S&P 500 ETF	$ 304.10
AAPL	Apple Inc.	$(538.29)
SPY	SPDR S&P 500 ETF	$ 274.10
SQ	Square	$ 466.71
AAPL	Apple Inc.	$ 87.77
IBM	International Business Machines Corporation	$ 262.10
NVDA	NVIDIA Corporation	$ 708.93
SPY	SPDR S&P 500 ETF	$ 286.69
BA	The Boeing Company	$ 933.90

<tbody>
</tbody>

icker

Name

Total

<tbody>
</tbody>

AAPL	Apple Inc.	$($657.92)
BA	The Boeing Company	$(122.23)
IBM	International Business Machines Corporation	$262.10
NVDA	NVIDIA Corporation	$708.93
SPY	SPDR S&P 500 ETF	$(864.89)
SQ	Square	$466.71

<tbody>
</tbody>

 

[Michael M]

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

 

[Av8tordude]

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

BA	The Boeing Company	($122.23)
AAPL	Apple Inc.	($675.92)
IBM	International Business Machines Corporation	$262.10
NVDA	NVIDIA Corporation	$708.93
SPY	SPDR S&P 500 ETF	$864.89
SQ	Square	$466.71
BA	The Boeing Company	$495.67

<tbody>
</tbody>

This is the output it gave me....

BA	The Boeing Company	($617.90)
AAPL	Apple Inc.	($675.92)
IBM	International Business Machines Corporation	$262.10
NVDA	NVIDIA Corporation	$708.93
SPY	SPDR S&P 500 ETF	$864.89
SQ	Square	$466.71
BA	The Boeing Company	$495.67

<tbody>
</tbody>

 

[Peter_SSs]

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

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

 

[Michael M]

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

 

[Av8tordude]

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

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

 

[Av8tordude]

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

 

[Peter_SSs]

This worked out great Peter. Thank you kindly for your assistance.

You're welcome. Glad it worked for you.

 

[Av8tordude]

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) ?

[COLOR=#333333].Columns(3).Formula = "=SUMIF(" & rData.Columns(1).Address & ",W1," & rData.Columns(3).Address & ")"[/COLOR]

 

[Av8tordude]

bump

 

[Peter_SSs]

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) ?

[COLOR=#333333].Columns(3).Formula = "=SUMIF(" & rData.Columns(1).Address & ",W1," & rData.Columns(3).Address & ")"[/COLOR]

Would this be sufficient?

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