Sub total for off set columns based on dynamic change?

[Mausten]

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,

 

[Lewiy]

Have you considered using a Pivot Table for this?

 

[Beate Schmitz]

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>

 

[Joe Was]

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