Clean-up code to AutoFilter workbooks

[Deepak88]

Hello All,

Below is code for applying filter across different open workbooks, however I am getting run time error 438. Can anyone please help me on this.

Sub filter_All_Workbooks()

Dim objbook As Workbook, objMAinbook As Workbook
Dim arrAllFilters() As String
Dim byteCountFilter As Byte, i As Byte

Set objMAinbook = ActiveWorkbook
' insert all criteria and address
If insertAllFilters(arrAllFilters, byteCountFilter) Then

Application.ScreenUpdating = False
' If is allright, go on
For Each objbook In ActiveWorkbook.Workbooks
' don't do on same book
If objbook.Name <> objMAinbook.Name Then

On Error GoTo errhandler
'check Autofilter, if one is off = switch on
objbook.Select
If Not objbook.AutoFilterMode Then
' if book doesn't contain some data
Range(arrAllFilters(4, 1)).AutoFilter
End If

' here I know taht Autofilter is On
' filter some item
For i = 1 To byteCountFilter
' only 1 criteria (without Operator)
If arrAllFilters(2, i) = 0 Then
Range(arrAllFilters(4, i)).AutoFilter _
Field:=Range(arrAllFilters(4, i)).Column, _
Criteria1:=arrAllFilters(1, i)
' with operator
ElseIf arrAllFilters(2, i) <> 0 Then
Range(arrAllFilters(4, i)).AutoFilter _
Field:=Range(arrAllFilters(4, i)).Column, _
Criteria1:=arrAllFilters(1, i), _
Operator:=arrAllFilters(2, i), _
Criteria2:=arrAllFilters(3, i)
End If
Next i

End If
Next objbook
Else
'While Main book doesn't contain data or Autofilter is off
MsgBox "Main book (Name """ & objMAinbook.Name & """) doesn't some data or it doesn't use !" _
& vbCrLf & "This code can't go on.", vbCritical, "Missing Autofilter object or filter item "

Set objMAinbook = Nothing
Set objbook = Nothing

Application.ScreenUpdating = True

Exit Sub
End If

objMAinbook.Activate
Set objMAinbook = Nothing
Set objbook = Nothing

Application.ScreenUpdating = True

MsgBox "Finished"
Exit Sub

errhandler:
Set objMAinbook = Nothing
Set objbook = Nothing

Application.ScreenUpdating = True

If Err.Number = 1004 Then
MsgBox "Probable cause of error - book dosn't contain some data", vbCritical, "Error Exception on book " & Activebook.Name
Else
MsgBox "Sorry, run exception"
End If

End Sub
Function insertAllFilters(arrAllFilters() As String, byteCountFilter As Byte) As Boolean
' go throught all filters and inserting their address and criterial
Dim myFilter As Filter
Dim myFilterRange As Range
Dim boolFilterOn As Boolean
Dim i As Byte, byteColumn As Byte

boolFilterOn = False: i = 0: byteColumn = 0
' If AutoFilter is off - return False
If Not ActiveWorkbook.AutoFilterMode Then
insertAllFilters = False
Exit Function
End If

' If Autofilter is on & no filter any item = return false
For Each myFilter In ActiveWorkbook.AutoFilter.Filters
If myFilter.On Then
boolFilterOn = True
Exit For
End If
Next myFilter
' Check Filter
If Not boolFilterOn Then
insertAllFilters = False
Exit Function
End If

On Error GoTo errhandler
' here is all control done
With ActiveWorkbook.AutoFilter
For Each myFilter In .Filters
byteColumn = byteColumn + 1
If myFilter.On Then
i = i + 1
ReDim Preserve arrAllFilters(1 To 4, 1 To i)
arrAllFilters(1, i) = myFilter.Criteria1
arrAllFilters(2, i) = myFilter.Operator
If myFilter.Operator <> 0 Then
arrAllFilters(3, i) = myFilter.Criteria2
End If
arrAllFilters(4, i) = .Range.Columns(byteColumn).Cells(1).Address
End If
Next myFilter
End With

byteCountFilter = i
insertAllFilters = True
Set myFilter = Nothing
Set myFilterRange = Nothing
Exit Function

errhandler:
insertAllFilters = False
Set myFilter = Nothing
Set myFilterRange = Nothing

End Function