Some of the very best Excel work in the early years was done by Stephen Bullen. His legacy Excel site still exists, but it has not been updated in many years.
http://www.oaltd.co.uk/Excel/Default.htm
One of Stephen’s creations was a “simple” VBA function to return the applied criteria of a filtered list to a worksheet cell (shown below).
Function FilterCriteria(Rng As Range) As String
‘By Stephen Bullen
Dim Filter As String
Filter = “”
On Error GoTo Finish
With Rng.Parent.AutoFilter
If Intersect(Rng, .Range) Is Nothing Then GoTo Finish
With .Filters(Rng.Column – .Range.Column + 1)
If Not .On Then GoTo Finish
Filter = .Criteria1
Select Case .Operator
Case xlAnd
Filter = Filter & ” AND ” & .Criteria2
Case xlOr
Filter = Filter & ” OR ” & .Criteria2
End Select
End With
End With
Finish:
FilterCriteria = Filter
End Function
The use of this function is illustrated in the following figure. The formulas are in row 1.
Here is another view with criteria applied to other columns.
It also shows a limitation that this function had. Since the .Criteria1 and Criteria2 properties are strings, when criteria is set for a date column, the string contains Excel’s “date number”, not the date formatted number displayed in the cells. In order to workaround this limitation, I amended the function as shown below.
Function FilterCriteriaEnh(Rng As Range) As String ‘Enhanced to handle date filters
‘By Stephen Bullen and David Hager
Dim Filter As String
Dim Criteria2 As String
Filter = “”
sFormat = Application.Index(Rng, 2).NumberFormat
‘On Error GoTo Finish
With Rng.Parent.AutoFilter
If Intersect(Rng, .Range) Is Nothing Then GoTo Finish
With .Filters(Rng.Column – .Range.Column + 1)
If Not .On Then GoTo Finish
Filter = .Criteria1
If sFormat = “m/d/yyyy” Then
Filter = Left(Filter, InStr(Filter, OnlyDigits(Filter)) – 1) & _
Format(OnlyDigits(Filter), sFormat)
On Error GoTo Finish
Criteria2 = Left(.Criteria2, InStr(.Criteria2, OnlyDigits(.Criteria2)) – 1) & _
Format(OnlyDigits(.Criteria2), sFormat)
End If
Select Case .Operator
Case xlAnd
Filter = Filter & ” AND ” & Criteria2
Case xlOr
Filter = Filter & ” OR ” & Criteria2
End Select
End With
End With
Finish:
FilterCriteriaEnh = Filter
End Function
Function OnlyDigits(s As String) As String
With CreateObject(“vbscript.regexp”)
.Pattern = “\D”
.Global = True
OnlyDigits = .Replace(s, “”)
End With
End Function
First, I needed to capture the format from the column is question to see if it was date formatted.
sFormat = Application.Index(Rng, 2).NumberFormat
If sFormat = “m/d/yyyy” Then
Filter = Left(Filter, InStr(Filter, OnlyDigits(Filter)) – 1) & _
Format(OnlyDigits(Filter), sFormat)
The change in the string for the Filter variable is made by the formula shown above. The OnlyDigits function used in the formula construction is not original, but I do not know the source. It puts the string back together with the date replacing the date system number.
I did the same thing for Criteria2, but it will not exist if a second criteria is not selected in the filter, so I had to add error handling for that scenario.
On Error GoTo Finish
Criteria2 = Left(.Criteria2, InStr(.Criteria2, OnlyDigits(.Criteria2)) – 1) & _
Format(OnlyDigits(.Criteria2), sFormat)
A final filter list example using this enhanced function is shown below.
You can download the file for this here.