PDA

View Full Version : Filter all sheets by filtering one sheet



Andy1973
01-11-2016, 02:11 PM
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


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


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

SamT
01-11-2016, 05:58 PM
If you place the cursor next to or inside a keyword and press F1, the help page for that key word will display.

Wow, what a mess of old redundant spaghetti code.


Old: Note that the variable byteColumn is Typed as a Byte. A Byte is limited to 256, the column limit for Excel < 2007.
Redundant: "boolFilterOn = False: i = 0: byteColumn = 0" is setting the uninitialized variables to their uninitialized values. There are more examples


First see: http://www.ozgrid.com/VBA/autofilter-vba.htm
Then: https://msdn.microsoft.com/en-us/library/office/ff194617.aspx

You will see that you really only need one Procedure to accomplish what you want.


First apply some of the code in the first link to see if there are any filters on the active sheet, IF NOT then exit the sub.
Next, the first Procedure in the second link will save the filters, then loop thru the remaining sheets with the second procedure.


Let us know if you need more help.

Code in the Links:

With ActiveSheet
If .AutoFilterMode = True And .FilterMode = True Then
MsgBox "They are visible and in use"
ElseIf .AutoFilterMode = True Then
MsgBox "They are visible but not in use"
Else
MsgBox "They are not visible or in use"
End If
End With

Dim w As Worksheet
Dim filterArray()
Dim currentFiltRange As String

'Sub ChangeFilters()
Sub SaveFilters()

Set w = Worksheets("Crew")
With w.AutoFilter
currentFiltRange = .Range.Address
With .Filters
ReDim filterArray(1 To .Count, 1 To 3)
For f = 1 To .Count
With .Item(f)
If .On Then
filterArray(f, 1) = .Criteria1
If .Operator Then
filterArray(f, 2) = .Operator
filterArray(f, 3) = .Criteria2
End If
End If
End With
Next
End With
End With
End Sub

Sub RestoreFilters()
Set w = Worksheets("Crew")
w.AutoFilterMode = False
For col = 1 To UBound(filterArray(), 1)
If Not IsEmpty(filterArray(col, 1)) Then
If filterArray(col, 2) Then
w.Range(currentFiltRange).AutoFilter field:=col, _
Criteria1:=filterArray(col, 1), _
Operator:=filterArray(col, 2), _
Criteria2:=filterArray(col, 3)
Else
w.Range(currentFiltRange).AutoFilter field:=col, _
Criteria1:=filterArray(col, 1)
End If
End If
Next
End Sub

Andy1973
01-12-2016, 04:37 AM
Thanks a lot, SamT. I'll go through that later when I get home from work!

Hopefully when I'm proficient I'll be able to help someone else out.

Thanks again

Andy1973
01-17-2016, 10:24 AM
Hello SamT

I've started looking through the code and can follow the first example. But I'm sketchy on the second part.

I've added some questions below. If you could help I'd appreciate it.



'Declaring a variable of type Worksheet
Dim w As Worksheet
'Declaring an array called filterArray, or is this a built in array?
Dim filterArray()
'Decalring a variable of type string
Dim currentFiltRange As String

'Sub ChangeFilters()

Sub SaveFilters()
' is 'crew' the name of the excel workbook or the specific worksheet?
Set w = Worksheets("Crew")

With w.AutoFilter
' assigning the variable currentFiltRange the address of the range - but the range of what?
' is the .Range.Address a property of autofilter?
currentFiltRange = .Range.Address

' is the .Filter a property of autofilter?
With .Filters
' is this initialising the array
' is the 1 to .count counting the number od worksheets?
'what does the 1 to 3 relate to?
ReDim filterArray(1 To .Count, 1 To 3)
For f = 1 To .Count
With .Item(f)
If .On Then
filterArray(f, 1) = .Criteria1
If .Operator Then
filterArray(f, 2) = .Operator
filterArray(f, 3) = .Criteria2
End If
End If
End With
Next
End With
End With
End Sub

SamT
01-17-2016, 12:23 PM
Every sub in the project can use these variables
'Declaring a variable of type Worksheet
Dim w As Worksheet
'Declaring an array called filterArray, or is this a built in array? No it,s not
Dim filterArray()
'Decalring a variable of type string
Dim currentFiltRange As String


' is this initialising the array Yes.
' is the 1 to .count counting the number od worksheets? The number of Filters on the Sheet
ReDim filterArray(1 To .Count, 1 To 3)



what does the 1 to 3 relate to?

You can think of filterArray as a board of cup hooks, .Count tall and three wide. For f = 1, your code is hanging each of the Properties of the first Filter on the hooks in the top row. At f = 2, it hangs the Properties of the second on the second row. and so on.

In VBA, when relating Arrays to Ranges think of Arrays as Arr(1, 3) as the same as Arr(Row, Column) and Cells(r, c).

By default the indexing of Arrays starts at zero, so if you did not specifically initialize the array with Arr(1 To N), the first "Row" number would be 0.

For f = 0 to .Count -1
filterArray(f, 0) = .Criteria1
If .Operator Then
filterArray(f, 1) = .Operator
filterArray(f, 2) = .Criteria2
End If
Next

Putting "Option Base 1" at the top of a code page "changes the Default" Array Base Index to 1 for that Module.

SamT
01-17-2016, 12:40 PM
' is 'crew' the name of the excel workbook or the specific worksheet?
Set w = Worksheets("Crew")
Set WkBk = Workbooks("MyBook.xls")
Set Wks = WkBk.Worksheets("Crew")


With w.AutoFilter
' assigning the variable currentFiltRange the address of the range - but the range of what?
' is the .Range.Address a property of autofilter?
currentFiltRange = .Range.Address
For an AutoFilter object, returns a Range object that represents the range to which the specified AutoFilter applies.