1 Attachment(s)
Filter all sheets by filtering one sheet
Good evening,
I'm new to these kind of help forums so hopefully I'm following etiquette.
I have a certain amount of knowledge of C++/ C# and VB and made an attempt to write a Macro in excel that filters all the sheets in a workbook when you filter the first sheet.
I managed to get something working on a very basic level.
However, I stumbled across the code below and it does exactly what I want it to do. It came with comments but it isn't comprehensive.
I don't suppose anyone out there would be prepared to comment it so that I can follow exactly what is happening. The reason I want to follow it is that I feel this is the best way for me to learn and build upon something I know that works.
Thanks in advance.
Andy
Code:
Sub AutoFilter_All_Sheets()
Dim objSheet As Worksheet, objMainSheet As Worksheet
Dim arrAllFilters() As Variant
Dim byteCountFilter As Byte, i As Byte
Set objMainSheet = ActiveSheet
If insertAllFilters(arrAllFilters, byteCountFilter) Then
Application.ScreenUpdating = False
For Each objSheet In ActiveWorkbook.Worksheets
'Skip the starting sheet
If objSheet.Name <> objMainSheet.Name Then
On Error GoTo errhandler
'check Autofilter, if one is off = switch on
objSheet.Select
objSheet.AutoFilterMode = False 'clear existing filtering
If Not objSheet.AutoFilterMode Then
' if sheet doesn't contain some data
Range(arrAllFilters(4, 1)).AutoFilter
End If
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)
'Filter 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 objSheet
Else
For Each objSheet In ActiveWorkbook.Worksheets
If objSheet.Name <> objMainSheet.Name Then
objSheet.Activate
objSheet.AutoFilterMode = False
End If
Next objSheet
If Not objMainSheet.AutoFilterMode Then
'Main Sheet doesn't contain data or Autofilter is off
MsgBox "Sheet (Name """ & objMainSheet.Name & """) doesn't contain data or the Autofilter is off!" _
& vbCrLf & "This code can't continue.", vbCritical, "Missing Autofilter object or filter item"
End If
Set objMainSheet = Nothing
Set objSheet = Nothing
Application.ScreenUpdating = True
Exit Sub
End If
objMainSheet.Activate
Set objMainSheet = Nothing
Set objSheet = Nothing
Application.ScreenUpdating = True
Exit Sub
errhandler:
Set objMainSheet = Nothing
Set objSheet = Nothing
Application.ScreenUpdating = True
If Err.Number = 1004 Then
MsgBox "Probable cause of error - sheet dosn't contain some data", vbCritical, "Error Exception on sheet " & ActiveSheet.Name
Else
MsgBox "Sorry, run exception"
End If
End Sub
Code:
Function insertAllFilters(arrAllFilters() As Variant, 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
Dim x As Variant
boolFilterOn = False: i = 0: byteColumn = 0
' If AutoFilter is off - return False
If Not ActiveSheet.AutoFilterMode Then
insertAllFilters = False
Exit Function
End If
' If Autofilter is on & doesn't filter any item = return false
For Each myFilter In ActiveSheet.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
With ActiveSheet.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
On Error Resume Next
x = myFilter.Criteria2
If Err.Number = 0 Then 'Criteria2 exists
On Error GoTo 0 'errorhandler
If myFilter.Operator <> 0 Then
arrAllFilters(3, i) = myFilter.Criteria2
End If
End If
On Error GoTo 0
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
