COUNTA AND COUNTIF in a macro

hi again,

I've played around a little & have come up with the below (please note that I haven't thoroughly tested it). Also, I haven't included all your formatting code but I think you'll be able to add this into the right place. :-)

Option Explicit

Sub FilterAndCopyByGroupings()
Const HdrRw As Long = 4
Dim LR As Long
Dim i As Long
Dim StatusStrToFilterArr As Variant
Dim ShtsArr As Variant
Dim FilterFldArr As Variant
Dim DestRng As Range
Dim RngToCopy As Range
Dim FirstBlankRw As Long
    Application.ScreenUpdating = False
    StatusStrToFilterArr = Array("=NEW*", "=RW*", "=TERM*", "=REINS*", "=CHANGE*", "=YES*")
    FilterFldArr = Array(8, 8, 8, 8, 8, 15)
    With ThisWorkbook
        Set ShtsArr = .Worksheets(Array("NEW", "RENEWALS", "TERMS", "REINSTATEMENTS", "CHANGE", "CERIDIAN"))
        With .Worksheets("ALL")
            With .Range(.Cells(HdrRw, 1), LastCell(Worksheets("ALL")))
                'test if a filter is on the sheet & remove - just in case it is incorrectly sized
                If .Parent.FilterMode Then .AutoFilter
'reapply the autofilter to the correct range
.autofilter
                'loop through the criteria
                For i = LBound(StatusStrToFilterArr) To UBound(StatusStrToFilterArr)
                    .AutoFilter Field:=FilterFldArr(i), Criteria1:=StatusStrToFilterArr(i)
                    'in case there are no visible rows
                    On Error Resume Next
                    With ShtsArr(i + 1)
                        FirstBlankRw = LastCell(CVar(ShtsArr(i + 1))).Row + 1
                        Set DestRng = .Cells(FirstBlankRw, 1)
                    End With
                    Set RngToCopy = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible)
                    ''copy the data rows to the appropriate sheet
                    'Application.Goto DestRng 'for testing
                    'Application.Goto RngToCopy 'for testing
                    RngToCopy.Copy DestRng
                    With ShtsArr(i + 1)
                        FirstBlankRw = LastCell(CVar(ShtsArr(i + 1))).Row + 1
'### you may want to change these to the suggestion in my previous post
                        .Range("B" & FirstBlankRw) = "TOTAL"
                        .Range("E" & FirstBlankRw).FormulaR1C1 = "=SUM(R2C:R" & FirstBlankRw - 1 & "C)"
                        .Range("F" & FirstBlankRw).FormulaR1C1 = "=SUM(R2C:R" & FirstBlankRw - 1 & "C)"
                    End With
                    Set DestRng = Nothing
                    Set RngToCopy = Nothing
                    On Error GoTo 0
                    .AutoFilter Field:=FilterFldArr(i)
                Next i
                .AutoFilter
            End With
        End With
    End With
    Set ShtsArr = Nothing
    Application.ScreenUpdating = True
End Sub

Function LastCell(ws As Worksheet) As Range
' sourced from http://www.beyondtechnology.com/geeks012.shtml
'to identify the lastcell on a worksheet (& not necessarily the active sheet)
Dim LastRow As Long
Dim LastCol As Long
    ' Error-handling is here in case there is not any
    ' data in the worksheet
    On Error Resume Next
    With ws
        ' Find the last real row
        LastRow = .Cells.Find(What:="*", _
                              SearchDirection:=xlPrevious, _
                              SearchOrder:=xlByRows).Row
        LastRow = Application.WorksheetFunction.Max(1, LastRow)
        ' Find the last real column
        LastCol = .Cells.Find(What:="*", _
                              SearchDirection:=xlPrevious, _
                              SearchOrder:=xlByColumns).Column
        LastCol = Application.WorksheetFunction.Max(1, LastCol)
    End With
    On Error GoTo 0
    ' Finally, initialize a Range object variable for
    ' the last populated row.
    Set LastCell = ws.Cells(LastRow, LastCol)
End Function

hth
Rob