MACRO HELP WITH SUBTOTAL AND RANGES

[Gemi]

I am new to using macros and need some help! Here is the problem with some
backround:
I run a report each week where I need to filter and delete unecessary
information and then sort and subtotal the remainder. I sort by agent name
(column A) and then by agent activity (column D) I then subtotal at each
change in Agent Name use function count add subtotal to Column B. I then
subtotal again for each change in Agent Activity (column D) use function
count and add subtotal to Column E. I created the macro by using record
macro and it works when I test it on the data that I created it on. However,
if I try it on a smaller or larger amount of data the subtotal for agent
activity does not work correctly it does not combine the activity for each
agent but subtotals every couple of rows. (this will change each week, the
columns will remain the same but the rows may be more or less) I believe the
problems lies within the subtotals I have set up. Thank you in advance for
any hep and advice!

Lee



Here is the macro:

Sub BCMreport()
'
' BCMreport Macro
' Used for weekly Customer Service report
'

'
Selection.AutoFilter
ActiveSheet.Range("$A$1:$E$3200").AutoFilter Field:=4, Criteria1:=Array( _
"Available Time", "Break Time", "Internal call", "Login Time",
"Logout", "Not Ready" _
), Operator:=xlFilterValues
Rows("2:3201").Select
Selection.Delete Shift:=xlUp
ActiveSheet.Range("$A$1:$E$1176").AutoFilter Field:=4
Columns("A:E").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add
Key:=Range("A2:A3200" _
), SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add
Key:=Range("D23200" _
), SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:E3200")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.Subtotal GroupBy:=1, Function:=xlCount, TotalList:=Array(2), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Selection.Subtotal GroupBy:=4, Function:=xlCount, TotalList:=Array(5), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
End Sub

 

[Dave Peterson]

Could it be that your code has Replace:=true for both .subtotal's?

I'd drop the selections to make it easier to update:

Option Explicit
Sub BCMreport()

Dim wks As Worksheet
Dim myRng As Range
Dim LastRow As Long

Set wks = ActiveSheet

With wks
'get the last used row (based on column A)
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set myRng = .Range("a1:E" & LastRow)

'remove any existing autofilter arrows
.AutoFilterMode = False

myRng.AutoFilter Field:=4, _
Criteria1:=Array("Available Time", _
"Break Time", _
"Internal call", _
"Login Time", _
"Logout", _
"Not Ready"), _
Operator:=xlFilterValues

'in case there are no visible rows after the filter
On Error Resume Next
With .AutoFilter.Range
.Resize(.Rows.Count - 1).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
On Error GoTo 0

'remove filter arrows
.AutoFilterMode = False

'get the new last used row (based on column A)
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set myRng = .Range("a1:E" & LastRow)

.Sort.SortFields.Clear

.Sort.SortFields.Add Key:=.Columns(1), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

.Sort.SortFields.Add Key:=.Columns(4), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

With .Sort
.SetRange myRng
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Application.DisplayAlerts = False
myRng.Subtotal GroupBy:=1, Function:=xlCount, _
TotalList:=Array(2), Replace:=True, _
PageBreaks:=False, SummaryBelowData:=True

'get the new last used row (based on column A)
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set myRng = .Range("a1:E" & LastRow)
myRng.Subtotal GroupBy:=4, Function:=xlCount, _
TotalList:=Array(5), Replace:=False, _
PageBreaks:=False, SummaryBelowData:=True
Application.DisplayAlerts = True

.Outline.ShowLevels RowLevels:=2
End With
End Sub

ps. I wouldn't use Autofilter and subtotals on the same sheet. They don't work
well together.

 

[Gemi]

Dave,

Thank you for your assistance, it works perfectly!

Lee