Well, problem solved. I found some neat code out here: http://www.ozgrid.com/forum/showthread.php?t=76618
which helped me solve the problem. My functioning code is shown below:
Sub Filter_All_Sheets()
'This one applies the autofilter from the MFR Adjustments page to all of the detail pages
Dim objSheet As Worksheet, objMAinSheet As Worksheet
Dim arrAllFilters() As String
Dim byteCountFilter As Byte, i As Byte
Set objMAinSheet = ActiveSheet
'insert all criteria and address
If insertAllFilters(arrAllFilters, byteCountFilter) Then
Application.ScreenUpdating = False
'If is allright, go on
For Each objSheet In Sheets(Array("Projections", "Projections2")) 'use this code to do specific sheets
'For Each objSheet In ActiveWorkbook.Worksheets 'use this code for every sheet
'Don't refilter the activesheet
If objSheet.Name <> objMAinSheet.Name Then
On Error GoTo errhandler
'check Autofilter, if one is off = switch on
objSheet.Select
objSheet.AutoFilterMode = False
If Not objSheet.AutoFilterMode Then
' if sheet doesn't contain some data
Range("A11:C11").AutoFilter
End If
'here I know that Autofilter is On
'filter some item
For i = 1 To byteCountFilter
'only 1 criteria (without Operator)
If arrAllFilters(2, i) = 0 Then
Range("A11:C11").AutoFilter _
Field:=Range(arrAllFilters(4, i)).Column, _
Criteria1:=arrAllFilters(1, i)
'with operator
ElseIf arrAllFilters(2, i) <> 0 Then
Range("A11:C11").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
'When Main Sheet doesn't contain data or Autofilter is off
MsgBox "Main Sheet (Name """ & objMAinSheet.Name & """) is missing some data or the autofilter is not being used!" _
& vbCrLf & "Try filtering on any column first." & vbCrLf & "This code can't go on.", vbCritical, "Missing Autofilter object or filter item "
Set objMAinSheet = Nothing
Set objSheet = Nothing
Application.ScreenUpdating = True
Exit Sub
End If
objMAinSheet.Activate
Set objMAinSheet = Nothing
Set objSheet = Nothing
Application.ScreenUpdating = True
MsgBox "Finished"
Exit Sub
errhandler:
Set objMAinSheet = Nothing
Set objSheet = Nothing
Application.ScreenUpdating = True
If Err.Number = 1004 Then
MsgBox "Probable cause of error - sheet doesn't contain some data", vbCritical, "Error Exception on sheet " & ActiveSheet.Name
Else
MsgBox "Sorry, run exception"
End If
End Sub
Function insertAllFilters(arrAllFilters() As String, byteCountFilter As Byte) As Boolean
' go through all filters 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 ActiveSheet.AutoFilterMode Then
insertAllFilters = False
Exit Function
End If
' If Autofilter is on & no 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
' here is where all the control is done
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
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
LinkBack URL
About LinkBacks
Register To Reply
, well it was a quess, can you post sample workbook (data is not important, just the structure with sheet objects) with a couple of sheets?
Bookmarks