Solved: Help with VBA subtotal and remove subtotal

**Char9** · 09-02-2010, 06:30 PM

Hi,

I'm not real familiar with VBA but have been assigned the task of updating a worksheet. The worksheet groups and subtotals information, but the problem is it shows a "count" figure on empty cells too. Then when I press the clear totals button on my worksheet, it doesn't clear all the totals from the empty cells. I hope this makes sense. I'm using Excel 2010 in 97-03 compatibility mode.

I want it to remove all the subtotal info when I run the remove subtotal vba. Better yet, I would prefer it didn't show subtotals on rows without any data to begin with.

I've attached the worksheet

Below is my VBA code:
[VBA]Sub CourseCount()
'
' CourseCount Macro

Range("A19:K208").Select
ActiveWindow.ScrollRow = 160
ActiveWindow.ScrollRow = 159
ActiveWindow.ScrollRow = 158
ActiveWindow.ScrollRow = 157
ActiveWindow.ScrollRow = 156
ActiveWindow.ScrollRow = 155
ActiveWindow.ScrollRow = 153
ActiveWindow.ScrollRow = 151
ActiveWindow.ScrollRow = 148
ActiveWindow.ScrollRow = 146
ActiveWindow.ScrollRow = 144
ActiveWindow.ScrollRow = 141
ActiveWindow.ScrollRow = 139
ActiveWindow.ScrollRow = 136
ActiveWindow.ScrollRow = 133
ActiveWindow.ScrollRow = 130
ActiveWindow.ScrollRow = 128
ActiveWindow.ScrollRow = 125
ActiveWindow.ScrollRow = 121
ActiveWindow.ScrollRow = 119
ActiveWindow.ScrollRow = 116
ActiveWindow.ScrollRow = 113
ActiveWindow.ScrollRow = 110
ActiveWindow.ScrollRow = 107
ActiveWindow.ScrollRow = 103
ActiveWindow.ScrollRow = 100
ActiveWindow.ScrollRow = 97
ActiveWindow.ScrollRow = 93
ActiveWindow.ScrollRow = 90
ActiveWindow.ScrollRow = 85
ActiveWindow.ScrollRow = 80
ActiveWindow.ScrollRow = 76
ActiveWindow.ScrollRow = 73
ActiveWindow.ScrollRow = 68
ActiveWindow.ScrollRow = 63
ActiveWindow.ScrollRow = 58
ActiveWindow.ScrollRow = 54
ActiveWindow.ScrollRow = 49
ActiveWindow.ScrollRow = 45
ActiveWindow.ScrollRow = 40
ActiveWindow.ScrollRow = 35
ActiveWindow.ScrollRow = 31
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 1
Selection.Sort Key1:=Range("E19"), Key2:=Range("F19"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Subtotal GroupBy:=5, Function:=xlCount, TotalList:=Array(5) _
, Replace:=True, PageBreaks:=False, SummaryBelowData:=False
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 25
ActiveWindow.ScrollRow = 28
ActiveWindow.ScrollRow = 31
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 35
ActiveWindow.ScrollRow = 37
ActiveWindow.ScrollRow = 40
ActiveWindow.ScrollRow = 42
ActiveWindow.ScrollRow = 45
ActiveWindow.ScrollRow = 47
ActiveWindow.ScrollRow = 50
ActiveWindow.ScrollRow = 52
ActiveWindow.ScrollRow = 54
ActiveWindow.ScrollRow = 57
ActiveWindow.ScrollRow = 60
ActiveWindow.ScrollRow = 63
ActiveWindow.ScrollRow = 65
ActiveWindow.ScrollRow = 67
ActiveWindow.ScrollRow = 69
ActiveWindow.ScrollRow = 71
ActiveWindow.ScrollRow = 73
ActiveWindow.ScrollRow = 75
ActiveWindow.ScrollRow = 77
ActiveWindow.ScrollRow = 78
ActiveWindow.ScrollRow = 79
ActiveWindow.ScrollRow = 80
ActiveWindow.ScrollRow = 79
ActiveWindow.ScrollRow = 78
ActiveWindow.ScrollRow = 77
ActiveWindow.ScrollRow = 75
ActiveWindow.ScrollRow = 74
ActiveWindow.ScrollRow = 73
ActiveWindow.ScrollRow = 72
ActiveWindow.ScrollRow = 70
ActiveWindow.ScrollRow = 68
ActiveWindow.ScrollRow = 66
ActiveWindow.ScrollRow = 64
ActiveWindow.ScrollRow = 63
ActiveWindow.ScrollRow = 62
ActiveWindow.ScrollRow = 61
ActiveWindow.ScrollRow = 60
ActiveWindow.ScrollRow = 59
ActiveWindow.ScrollRow = 58
ActiveWindow.ScrollRow = 57
ActiveWindow.ScrollRow = 56
ActiveWindow.ScrollRow = 55
ActiveWindow.ScrollRow = 54
ActiveWindow.ScrollRow = 52
ActiveWindow.ScrollRow = 51
ActiveWindow.ScrollRow = 50
ActiveWindow.ScrollRow = 48
ActiveWindow.ScrollRow = 47
ActiveWindow.ScrollRow = 45
ActiveWindow.ScrollRow = 43
ActiveWindow.ScrollRow = 42
ActiveWindow.ScrollRow = 40
ActiveWindow.ScrollRow = 38
ActiveWindow.ScrollRow = 37
ActiveWindow.ScrollRow = 35
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 33
ActiveWindow.ScrollRow = 31
ActiveWindow.ScrollRow = 30
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 28
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 26
ActiveWindow.ScrollRow = 25
ActiveWindow.ScrollRow = 24
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 22
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
End Sub
Sub ClearTotals()
'
' ClearTotals Macro

Range("A19:K208").Select
ActiveWindow.ScrollRow = 183
ActiveWindow.ScrollRow = 181
ActiveWindow.ScrollRow = 180
ActiveWindow.ScrollRow = 179
ActiveWindow.ScrollRow = 178
ActiveWindow.ScrollRow = 177
ActiveWindow.ScrollRow = 175
ActiveWindow.ScrollRow = 174
ActiveWindow.ScrollRow = 173
ActiveWindow.ScrollRow = 170
ActiveWindow.ScrollRow = 168
ActiveWindow.ScrollRow = 167
ActiveWindow.ScrollRow = 164
ActiveWindow.ScrollRow = 161
ActiveWindow.ScrollRow = 158
ActiveWindow.ScrollRow = 155
ActiveWindow.ScrollRow = 152
ActiveWindow.ScrollRow = 148
ActiveWindow.ScrollRow = 145
ActiveWindow.ScrollRow = 142
ActiveWindow.ScrollRow = 139
ActiveWindow.ScrollRow = 134
ActiveWindow.ScrollRow = 130
ActiveWindow.ScrollRow = 126
ActiveWindow.ScrollRow = 121
ActiveWindow.ScrollRow = 117
ActiveWindow.ScrollRow = 114
ActiveWindow.ScrollRow = 109
ActiveWindow.ScrollRow = 105
ActiveWindow.ScrollRow = 100
ActiveWindow.ScrollRow = 96
ActiveWindow.ScrollRow = 91
ActiveWindow.ScrollRow = 86
ActiveWindow.ScrollRow = 81
ActiveWindow.ScrollRow = 77
ActiveWindow.ScrollRow = 72
ActiveWindow.ScrollRow = 67
ActiveWindow.ScrollRow = 61
ActiveWindow.ScrollRow = 57
ActiveWindow.ScrollRow = 52
ActiveWindow.ScrollRow = 47
ActiveWindow.ScrollRow = 43
ActiveWindow.ScrollRow = 39
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 30
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 24
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 1
Selection.RemoveSubtotal
End Sub
[/VBA]
Any help you can give would be greatly appreciated. Thank you!

**Blade Hunter** · 09-02-2010, 07:19 PM

Try this (Replaces ALL your code)

[vba]
Sub CourseCount()
With Range("A19:K208")
.Sort Key1:=Range("E19"), Key2:=Range("F19"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
.Subtotal GroupBy:=5, Function:=xlCount, TotalList:=Array(5) _
, Replace:=True, PageBreaks:=False, SummaryBelowData:=False
End With
End Sub
Sub ClearTotals()
Cells.RemoveSubtotal
End Sub
[/vba]

**Char9** · 09-02-2010, 07:40 PM

Oh my gosh! Thank you! It works. Do you know if it can be setup to not calculate the rows that don't have any data in them or not? No big deal if can't. I was just thinking it would be nice to not have all the rows that say "Count' in them when I go to print. But I could fix that by just selecting the rows that do have data and just printing that selection.

You are a lifesaver, I was banging my head against the desk. Thank you!

Thread: Solved: Help with VBA subtotal and remove subtotal

Thread Tools

Display

Solved: Help with VBA subtotal and remove subtotal

Posting Permissions