I have a handy function that's called from cell C1 that populates the cell with the filters that have been applied to Column C using the filters dropdown: =ShowColumnFilter(C:C)
As soon as the user clicks OK in the dropdown, the cell displays the filter(s).
However, when I apply a filter to that same column using VBA below from a command button or hyperlink, the column is correctly filtered but the Function ShowColumnFilter returns an error.
'Code Snippet:
With ActiveSheet.Range("A:W")
.AutoFilter Field:=3, Criteria1:="Some Criteria Here"
End With
Function ShowColumnFilter(rng as Range)
'Only the relevant code included here. Works fine when filtering through dropdown, but gives error after applying filter through the VBA in Worksheet_FollowHyperlink.
Dim sh As Worksheet
Dim frng As Range
Set sh = rng.Parent
Debug.Print sh.FilterMode
'When filtered from UI dropdown OR after executing VBA Code Snippet from Worksheet_FollowHyperlink returns TRUE
Debug.Print sh.AutoFilter.FilterMode
'When filtered from UI dropdown returns TRUE but after executing VBA from hyperlink or command button creates an error: "Object variable or With block variable not set"
Set frng = sh.AutoFilter.Range 'Errors only after filtering by executing VBA from separate routine
...
End Function
This one has me perplexed because the function ShowColumnFilter is populating a cell and is not invoked directly by another sub. I'm trying to populate C1 with the filtering that has been applied to the column regardless of how the user filtered it. Any help is greatly appreciated.
Full code here:
Function ShowColumnFilter(rng As Range)
On Error GoTo myErr
'> PURPOSE: Show filters used in a specific column _
USAGE: =ShowColumnFilter(C:C)
Dim filt As Filter
Dim sCrit1 As String
Dim sCrit2 As String
Dim sOp As String
Dim lngOp As Long
Dim lngOff As Long
Dim frng As Range
Dim sh As Worksheet
Dim i As Long
Set sh = rng.Parent
If sh.FilterMode = False Then
ShowColumnFilter = "No Active Filter"
Exit Function
End If
'**** Included only for debugging *****
Debug.Print sh.FilterMode
Debug.Print sh.AutoFilter.FilterMode
'**************************************
Set frng = sh.AutoFilter.Range
If Intersect(rng.EntireColumn, frng) Is Nothing Then
ShowColumnFilter = CVErr(xlErrRef)
Else
lngOff = rng.Column - frng.Columns(1).Column + 1
If Not sh.AutoFilter.Filters(lngOff).On Then
ShowColumnFilter = "No Conditions"
Else
Set filt = sh.AutoFilter.Filters(lngOff)
On Error Resume Next
lngOp = filt.Operator
If lngOp = xlFilterValues Then
For i = LBound(filt.Criteria1) To UBound(filt.Criteria1)
sCrit1 = sCrit1 & filt.Criteria1(i) & " or "
Next i
sCrit1 = Left(sCrit1, Len(sCrit1) - 3)
Else
sCrit1 = filt.Criteria1
sCrit2 = filt.Criteria2
If lngOp = xlAnd Then
sOp = " And "
ElseIf lngOp = xlOr Then
sOp = " or "
Else
sOp = ""
End If
End If
ShowColumnFilter = sCrit1 & sOp & sCrit2
End If
End If
myExit:
Exit Function
myErr:
Call ErrorLog(Err.Description, Err.Number, "GlobalCode", "ShowColumnFilter", True)
Resume myExit
End Function
Sub ErrorLog(strErrDescription As String, lngErrNumber As Long, strSheet As String, strSubName As String, bolShowError As Boolean)
On Error GoTo myErr
'> PURPOSE: Record Errors in an Error Log
If bolShowError = True Then _
MsgBox "An error has occured running " & strSubName & " on worksheet " & strSheet & ": " & Err.Number & " - " & Err.Description, vbInformation, "VBA Error"
myExit:
Exit Sub
myErr:
MsgBox "VBA Error - Error Log: " & Err.Number & " - " & Err.Description
Resume myExit
End Sub
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
On Error GoTo myErr
'> PURPOSE: Fires whenever a hyperlink is clicked on Sheet 1
Dim sValue as String
sValue = "Some Useful Criteria"
'> Select the sheet:
Sheets("MySheetName").Select
With ActiveSheet.Range("A:W")
If Len(sValue) > 0 Then _
.AutoFilter Field:=3, Criteria1:=sValue
End With
'> Go to the top row:
ActiveWindow.ScrollRow = 1
myExit:
Exit Sub
myErr:
Call ErrorLog(Err.Description, Err.Number, "Sheet1", "FollowHyperlink", True)
Resume myExit
End Sub