Help! Subtotal using formulas or VBA

[michael.beckinsale]

Hi All,

I have a list which is approx 35000 rows by 9 columns (A:I) which
needs to be subtotalled in Column G on each change in column A. There
will be approx 2800 subtotals. Once the list is subtotalled it needs
to be filtered to only show the rows & which do NOT result in a
subtotal of 0.

I have tried data/subtotals but you cannot filter the result.

I attemped to put a formula in column J to total on each change in
column A but the number of elements in column A is variable, so
finding the number of rows to total is difficult if not impossible.

Seems to me that l am left with VBA but l have no idea what the code
should look like!

Anybody got any ideas / sample code. This is really starting to
frustrate me.

TIA

Regards

MB

 

[Bob Phillips]

How about adding a helper column to calculate the subtotal (but on every
row, not at the end), and then filter out those that are 0.

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[michael.beckinsale]

Hi Bob,

I tried that but the filter does not seem to work properly while the
data/subtotals are applied.

I also tried same and then converting helper column to values rather
than formulas & removing subtotals but of course that removes the rows
the subtotals were on!

I am really struggling with this, is there some way the subtotals can
be inserted by VBA without the grouping action performed using data/
subtotals? It wouldn't be the perfect solution but l could work with
the result to get what l want.

Any help ideas would really be appreciated. This is becoming a major
stumbling block in this project.

TIA

MB

 

[Bob Phillips]

I was suggesting not having data/subtotals.

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[par_60056]

Hi Bob,

I tried that but the filter does not seem to work properly while the
data/subtotals are applied.

I also tried same and then converting helper column to values rather
than formulas & removing subtotals but of course that removes the rows
the subtotals were on!

I am really struggling with this, is there some way the subtotals can
be inserted by VBA without the grouping action performed using data/
subtotals? It wouldn't be the perfect solution but l could work with
the result to get what l want.

You might try a macro something like this:

sub addTotals()
dim currRow as long
dim startRow as long
dim blankCount as integer

blankCount=0
currRow=1
startRow=1
While blankCount < 4
if (isempty(cells(currRow,1))) then
blankCount=blankCount+1
else
blankCount=0
end if
if (cells(currRow,1)<>cells(currRow+1,1) then
Rows(currRow+1).Insert shift:=xlDown
cells(currRow+1,7)="=sum(G"+format(startRow)
+":G"+format(currRow)+")"
if (cells(currRow+1,7).value = 0) then
rows(format(startRow)+":"+format(currRow)).hidden=true
end if
currRow=currRow+1
startRow=currRow+1
end if
currRow=currRow+1
wend
end sub

This will insert a new row every time column A changes and only put a
sum formula into Column G on that row. If the value in the sum is 0
it will hide all the rows for that column A group. Since you said you
have 35000+ rows, make sure that your row index variables are longs
not integers.

I don't know what your data looks like but you might also look at
using a pivot table on a different sheet using your data as source.

Peter

 

[michael.beckinsale]

Hi Peter / Bob,

Thanks for all your help, sorry l did not reply earlier.

The code l eventually wrote which works within acceptable timescales
is copied below. I have used the column directly to the right of the
data as a helper column. Sorry if the commenting makes it difficult to
read. If you have any ideas for improving the code l am 'all ears'

Peter - I will try your code. It looks interesting and may be quicker
than mine and reduce workbook 'bloat' which is particularly important
in this workbook.

Once again many thanks.

Sub HelperFilterColumn()

Dim LR As Long 'Last row of loop
Dim sfr As Long 'Sum formula first row
Dim slr As Long 'Sum formula last row
Dim pn As Variant 'Personnel number to flag (ie put in
column J)

Application.ScreenUpdating = False

'Add subtotal to last row when value in column A changes
'-------------------------------------------------------
LR = Cells(Rows.Count, "A").End(xlUp).Row
sfr = 2
'....loop down insert subtotals
For i = 2 To LR
Cells(i, "A").Activate
'....when value changes i is equal to slr (sumif last row)
If Cells(i, "A").Value <> Cells(i + 1, "A").Value Then
slr = i
Cells(i, "J").Formula = "=Round(SUMIF($A$" & sfr & ":$A$"
& slr & ",$A" & i & ",$G$" & sfr & ":$G$" & slr & "),2)"
'....i + 1 = sfr (sumif 1st row) sets 1st row of next
sumif
sfr = i + 1
End If
Next i

'Insert values included in subtotal that does not = 0
'----------------------------------------------------
pn = ""
'....loop up and find subtotals that are not 0
For i = LR To 2 Step -1
Cells(i, "A").Activate
'....if pn refers to a non 0 subtotal copy value to J
If Cells(i, "A").Value = pn Then
Cells(i, "J").Value = Cells(i, "G").Value
End If
'....if subtotal is not 0 get personnel number (pn)
If Cells(i, "J").Value > 0 Or Cells(i, "J").Value < 0 Then
pn = Cells(i, "A").Value
End If
Next i
End Sub