writing a subtotal subroutine

[t16turbo]

hi there,

I have the results of a qeury which I then need to subtotal based on two different columns.

the data looks like this (simplified)

project location actuals etc
uk1234 UK 54 23
uk1234 UK 10 7
uk1234 Thai 10 15
uk1222 UK 26 5



I need to subtotal on change of project THEN change of location, so the above would look like:

UK1222 UK 26 5
TOTAL 26 5
UK1234 UK 54 23
UK1234 UK 10 7
TOTAL 64 30
UK1234 THAI 10 15
TOTAL 10 15

normal excel subtotals can be used on change of one column, not two.
does anyone have any suggestions for a solution to my requirements.

would it be straight forward to insert a line on change of project AND location, then sum the actuals and etc for it?


thanks in advance,

 

[Bong]

Have you tried using a pivot table?

_________________
Bob Rashkin

 

[PHV]

Create a concatened column:
[E1].Formula = "=A1&B1"
Range("E1:E5").FillDown
Range("A1:E5").Subtotal GroupBy:=5, Function:=xlSum, TotalList:=Array(3, 4), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[mrmovie]

'in code
+ order by your project code
+ loop down through project entries
+ check current project
+ look forward to the next line
+ if the next project is the same, add up total in memory
- if next project is not the same, insert new row, put in sum to date

 

[t16turbo]

thanks guys,

PH, your code is basically just the code generated by subtotals.
my live data will have about 1100 rows - and if I try to manually create it using the concat column it takes ages to run.

i'm wondering what I can do to improve the performance of it.
in reality I have about 5 or 6 columns that need summing.

any ideas?

thanks again

 

[mrmovie]

'thinking out loud here so bare with me
'record macro to sort on col 1
intRResults = 1
Set dicData = CreateObject("Scripting.Dictionary")
For i = 1 To 1000
strTemp = CStr(Cells(i, 1).Value)
If LCase(Trim(strTemp)) = LCase(Trim(CStr(Cells(i + 1).Value))) Then
If dicData.Count = 0 Then
Call setupTotals(i, dicData, 6)
Else
Call addTotals(i + 1, dicData, 6)
End If
Else
'different reference therefore write results
Call writeData(intRResults, dicData)
intRResults = intRResults + 1
dicData.RemoveAll
End If

Next

Sub setupTotals(ByVal intRow, ByRef dicData, ByVal numCols)
dicData.RemoveAll
For j = 1 To numCols
dicData.Add j, Cells(intRow, j).Value
Next

End Sub


Sub addTotals(ByVal intRow As Integer, ByRef dicData, ByVal numCols As Integer)
For j = 1 To numCols
dicData.Item(j) = dicData.Item(j) + Cells(intRow, j).Value
Next
End Sub

Sub writeData(ByVal intRowResults, ByRef dicData)
dim aKey As Variant
For Each aKey In dicData
Sheets("results").Cells(intRowResults, aKey).Value = dicData.Item(aKey)

Next
End Sub