Sub total for off set columns based on dynamic change?

Mausten

New Member
Joined
May 14, 2007
Messages
15
Hi perhaps some one can help with this?

I have an excel file that has a name colmun (this generated from other files using VBA). The name column just lists around 2000 names of buildings (duplicates included). Next to this column is the spend ascoicated with each building.

NAME SPEND
ddd 234
ddd 45
ds 67
df 87
fd 23
df 45

What I need is VBA that will sort the NAME field and then grab the total spend asociated with the (unique name). i.e

ddd 279
df 132

How can I do this ? I figure using offset to grab the value but I only want unique names with a total next to them - populated to a different 2 columns on the same sheet. The problem is we will never know the frequency of each name until they are generated and this frequency will be different each time.

Please advise a code snippet would be appareciated too I can make a button from this.

Thanks,
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
consolidation code

Hello,

if this would be your table:

<table border="1" cellspacing="0" cellpadding="0" style="font-family:Arial,Arial; font-size:10pt; background-color:#ffffff; padding-left:2pt; padding-right:2pt; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:80px;" /><col style="width:80px;" /><col style="width:80px;" /><col style="width:80px;" /><col style="width:80px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td><td >E</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td style="font-weight:bold; font-family:Verdana; font-size:9pt; ">NAME</td><td style="font-weight:bold; ">SPEND</td><td style="font-weight:bold; "> </td><td style="font-weight:bold; font-family:Verdana; font-size:9pt; "> </td><td style="font-weight:bold; "> </td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td style="font-family:Verdana; font-size:9pt; ">ddd</td><td style="text-align:right; ">234</td><td > </td><td > </td><td > </td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td style="font-family:Verdana; font-size:9pt; ">ddd</td><td style="text-align:right; ">45</td><td > </td><td > </td><td > </td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td style="font-family:Verdana; font-size:9pt; ">ds</td><td style="text-align:right; ">67</td><td > </td><td > </td><td > </td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td style="font-family:Verdana; font-size:9pt; ">df</td><td style="text-align:right; ">87</td><td > </td><td > </td><td > </td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td style="font-family:Verdana; font-size:9pt; ">fd</td><td style="text-align:right; ">23</td><td > </td><td > </td><td > </td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td style="font-family:Verdana; font-size:9pt; ">df</td><td style="text-align:right; ">45</td><td > </td><td > </td><td > </td></tr></table>

After this consolidation code:

<div style="background-color:#FFFFFF; border-width:2px; border-style: groove; border-color:#ff9966; padding:4px;"><nobr><span style="font-family:Courier New,Arial; font-size:9pt ;" ><span style="color:#000080"; >Sub</span> Consolidate()
Range(<span style="color:#800000"; >"D:E"</span>).ClearContents
Range(<span style="color:#800000"; >"A1:B1"</span>).Copy Range(<span style="color:#800000"; >"D1:E1"</span>)
Range(<span style="color:#800000"; >"D1"</span>).Consolidate Sources:=<span style="color:#800000"; >"R1C1:R65536C2"</span>, Function:= _
    xlSum, TopRow:=True, LeftColumn:=True, CreateLinks:=False
Columns(<span style="color:#800000"; >"D:E"</span>).Sort Key1:=Range(<span style="color:#800000"; >"D2"</span>), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
<span style="color:#000080"; >End</span> <span style="color:#000080"; >Sub</span>

</span></nobr></div>

it looks as follows:

<table border="1" cellspacing="0" cellpadding="0" style="font-family:Arial,Arial; font-size:10pt; background-color:#ffffff; padding-left:2pt; padding-right:2pt; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:80px;" /><col style="width:80px;" /><col style="width:80px;" /><col style="width:80px;" /><col style="width:80px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td><td >E</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td style="font-weight:bold; font-family:Verdana; font-size:9pt; ">NAME</td><td style="font-weight:bold; ">SPEND</td><td style="font-weight:bold; "> </td><td style="font-weight:bold; font-family:Verdana; font-size:9pt; ">NAME</td><td style="font-weight:bold; ">SPEND</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td style="font-family:Verdana; font-size:9pt; ">ddd</td><td style="text-align:right; ">234</td><td > </td><td >ddd</td><td style="text-align:right; ">279</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td style="font-family:Verdana; font-size:9pt; ">ddd</td><td style="text-align:right; ">45</td><td > </td><td >df</td><td style="text-align:right; ">132</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td style="font-family:Verdana; font-size:9pt; ">ds</td><td style="text-align:right; ">67</td><td > </td><td >ds</td><td style="text-align:right; ">67</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td style="font-family:Verdana; font-size:9pt; ">df</td><td style="text-align:right; ">87</td><td > </td><td >fd</td><td style="text-align:right; ">23</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td style="font-family:Verdana; font-size:9pt; ">fd</td><td style="text-align:right; ">23</td><td > </td><td > </td><td > </td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td style="font-family:Verdana; font-size:9pt; ">df</td><td style="text-align:right; ">45</td><td > </td><td > </td><td > </td></tr></table>
 
Upvote 0
You need to Sort the list first [If you want you can, record a macro and add it to the begining of the Sub below]:


Sub myFindListSubTotals()
'Sheet module code, like: Sheet1!
Dim obj1stRng As Object, obj2ndRng As Object
Dim myEnd As Boolean, booNew As Boolean
Dim lngMyRow&, lngMyCol&, lngSubTCol
Dim strMyStartNewNm$
Dim dubMySubTot#

'**** User Changeable Variables! *********************************************
'Look for Item list in Column?

lngMyCol = 1

'Start looking at Item list at Row?
lngMyRow = 2

'Column number to SubTotal?
lngSubTCol = 2
'**********************************************************************************

While Not myEnd
Set obj1stRng = Cells(lngMyRow, lngMyCol)
Set obj2ndRng = Cells(lngMyRow + 1, lngMyCol)

If (obj1stRng = obj2ndRng) And Not myEnd Then _
dubMySubTot = dubMySubTot + obj1stRng.Offset(0, lngSubTCol - lngMyCol).Value

If ((obj1stRng = obj2ndRng) And Not myEnd And booNew = False) Then
strMyStartNewNm = "Found New Item: """ & Cells(lngMyRow, lngMyCol) & ",""" & vbLf & _
"in rows: """ & lngMyRow
booNew = True
End If

If (obj1stRng <> obj2ndRng) And Not myEnd Then
booNew = False

dubMySubTot = dubMySubTot + obj1stRng.Offset(0, lngSubTCol - lngMyCol).Value

MsgBox strMyStartNewNm & " to " & lngMyRow & """" & vbLf & vbLf & _
"The Item: """ & Cells(lngMyRow, lngMyCol) & ",""" & vbLf & _
"SubTotal is: " & dubMySubTot, _
vbInformation + vbOKOnly, _
"New SubTotal!"

dubMySubTot = 0
End If

lngMyRow = lngMyRow + 1

If obj2ndRng = "" Then myEnd = True
Wend
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,530
Messages
6,114,162
Members
448,554
Latest member
Gleisner2

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