subtotals between blanks than skip a blank

[cricketnz]

Hi,


I need some help with vba


I've got this exported sales report http://www8.zippyshare.com/v/5789217/file.html

It doesn't have totals for the quantities.


I would like to use some vba code to add the totals for the quanties on each subtotal line

However I do not know how many months the user will export. Any ideas on what is required to do the job


Much appreciated


Jim

 

[cricketnz]

No reply, but an addition to above question


I've got this code below :

[pre]

Sub SumBetweenBlanks()
Dim Area As Range, MyColumn As String

MyColumn = "A"
For Each Area In Columns(MyColumn).SpecialCells(xlConstants, xlNumbers).Areas
SumAddr = Area.Address(False, False)
Area.Offset(Area.Count, 0).Resize(1, 1).Formula = "=SUM(" & SumAddr & ")"
Next Area
End Sub

[/pre]
This works fine on one column. I would like this code after it has finished column A, skip 3 columns to column E and do the same thing and so on.


As said before I have no idea how many sets of 4 columns there will be, but I would like to be able to subtotal the whole sheet for the qty colums with one sub routine ( or a set of sub routines).


Many thanks in advance for any ideas


Jim

 

[NARAYANK991]

Hi Jim ,


Try the following :

[pre]

Sub SumBetweenBlanks()
Dim Area As Range
Dim MyColumn As String
Dim i as Integer

MyColumn = "A"
For i = 1 To 3
For Each Area In Columns(MyColumn).SpecialCells(xlConstants, xlNumbers).Areas
SumAddr = Area.Address(False, False)
Area.Offset(Area.Count, 0).Resize(1, 1).Formula = "=SUM(" & SumAddr & ")"
Next Area
MyColumn = Columns(Columns(MyColumn).Column + 4).Address
Next
End Sub
The above code will repeat the summing action for columns E and I ; in case you want to extend this , you will have to see how many columns are present in the report , and then divide this by 4 to get the counter value ; to get the number of columns , you can use :


ActiveSheet.UsedRange.Columns.Count


Narayan

P.S.

Sub SumBetweenBlanks()
Dim Area As Range
Dim MyColumn As String
Dim i As Integer, maxcols as Integer

MyColumn = "A"
maxcols = ActiveSheet.UsedRange.Columns.Count

For i = 1 To maxcols  4
For Each Area In Columns(MyColumn).SpecialCells(xlConstants, xlNumbers).Areas
SumAddr = Area.Address(False, False)
Area.Offset(Area.Count, 0).Resize(1, 1).Formula = "=SUM(" & SumAddr & ")"
Next Area
MyColumn = Columns(Columns(MyColumn).Column + 4).Address
Next
End Sub

[/pre]

 

[cricketnz]

Hi Narayank.


I've tried the code under the P.S. but it gives me a runtime error "1004" "no cells were found"

and doesn't subtotal the last required column.


I added a new worksheet here and changed the initial MyColumn to "E"

here's the link to that workbook http://www34.zippyshare.com/v/24866612/file.html

Any suggestions?


Best regards


Jim

 

[NARAYANK991]

Hi Jim ,


The reason is the statement :

[pre]

For Each Area In Columns(MyColumn).SpecialCells(xlConstants, xlNumbers).Areas

[/pre]
which is looking only at cells which have constants in them.


Your column M does not contain any entered data ; all values in that column are a result of formulae ; these cells will not be considered in the above statement.


If you need to repeat the above exercise on column M , you will have to have a separate section with a different statement which considers cells which have formulae in them.


Narayan

 

[cricketnz]

Thanks, Narayank!


That certainly explained it.

I changed the formulas to values, but I still get the same error.

http://www73.zippyshare.com/v/66513756/file.html


The code does now total all required columns

Is there a way I can get rid of the error message?


Many thanks in advance

 

[NARAYANK991]

Hi Jim ,


I am not sure that this is the best way to do it , but it works :

[pre]

Sub SumBetweenBlanks()
Dim Area As Range
Dim MyColumn As String
Dim i As Integer, maxcols As Integer
Dim Error_Flag As Boolean

MyColumn = "E"
maxcols = ActiveSheet.UsedRange.Columns.Count
Error_Flag = False

For i = 1 To maxcols  4
On Error GoTo Error_handler
For Each Area In Columns(MyColumn).SpecialCells(xlConstants, xlNumbers).Areas
If Error_Flag Then Exit For
SumAddr = Area.Address(False, False)
Area.Offset(Area.Count, 0).Resize(1, 1).Formula = "=SUM(" & SumAddr & ")"
Next Area
MyColumn = Columns(Columns(MyColumn).Column + 4).Address
Next

GoTo Exit_Sub

Error_handler:
Error_Flag = True
Resume Next

Exit_Sub:
On Error GoTo 0
End Sub

[/pre]
Narayan

 

[cricketnz]

Hi Narayan


Many thanks for this! Much appreciated. The main thing for me is that it won't throw an error, and that goal has now been achieved.


Best regards,


Jim