How do I show Auto-Filter "Search" Criteria on Sheet1?

[golf4]

Hi, everyone -

I have a quick query that I was hoping to get some help with. I have
created a rent comparability tool, for my employer, that uses the
Auto-Filter to filter a database of housing unit information
("Comparability_Data") using 4 filter criteria, and shows the filtered
results in Sheet1. I have included the code below:

Private Sub CommandButton1_Click() 'Search for Comparable units'
Dim str As String
str = InputBox("Enter The CITY You Are Searching For:")
Sheets("Comparability_Data").UsedRange.AutoFilter Field:=2,
Criteria1:="=*" & str & "*", Operator:=xlAnd

str = InputBox("Enter The UNIT TYPE You Are Searching For:")
Sheets("Comparability_Data").UsedRange.AutoFilter Field:=3,
Criteria1:="=*" & str & "*", Operator:=xlAnd

cryMin = InputBox("Enter The MINIMUM BR SIZE Of Unit:")
cryMax = InputBox("Enter The MAXIMUM BR SIZE Of Unit:")
Sheets("Comparability_Data").UsedRange.AutoFilter Field:=8,
Criteria1:="<=" & cryMax, Operator:=xlAnd, Criteria2:=">=" & cryMin

cryMin = InputBox("Enter The MINIMUM RENT AMOUNT You Are Searching
For:")
cryMax = InputBox("Enter The MAXIMUM RENT AMOUNT You Are Searching:")
Sheets("Comparability_Data").UsedRange.AutoFilter Field:=6,
Criteria1:="<=" & cryMax, Operator:=xlAnd, Criteria2:=">=" & cryMin

cryMin = InputBox("Enter The MINIMUM YEAR BUILT of Unit:")
cryMax = InputBox("Enter The MAXIMUM YEAR BUILT Of Unit:")
Sheets("Comparability_Data").UsedRange.AutoFilter Field:=9,
Criteria1:="<=" & cryMax, Operator:=xlAnd, Criteria2:=">=" & cryMin

Sheets("sheet1").Range("A19:Ac39").Clear
Sheets("Comparability_Data").Range("a1:I16").SpecialCells(xlCellTypeVisible).Copy
Destination:=Sheets("sheet1").Range("a19")

Unload UserForm2
Sheets("SHEET1").Range("A1").Select
End Sub

My question is how would I modify the code to identify the filter
criteria used so that it would also appear on Sheet1? I was thinking,
maybe, in the footer or somewhere else visible on Sheet1.

Any help would be great --- Thanks!!!

Golf

 

[Tom Ogilvy]

http://j-walk.com/ss/excel/usertips/tip044.htm

to get it to refresh:

=FilterCriteria(B5)&left(Subtotal(9,B5:B200),0)


this is one I wrote back in 2000

Here is a user defined function that will display the criteria in a cell:

Public Function ShowFilter(rng As Range)
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
Set sh = rng.Parent
If sh.FilterMode = False Then
ShowFilter = "No Active Filter"
Exit Function
End If
Set frng = sh.AutoFilter.Range

If Intersect(rng.EntireColumn, frng) Is Nothing Then
ShowFilter = CVErr(xlErrRef)
Else
lngOff = rng.Column - frng.Columns(1).Column + 1
If Not sh.AutoFilter.Filters(lngOff).On Then
ShowFilter = "No Conditions"
Else
Set filt = sh.AutoFilter.Filters(lngOff)
On Error Resume Next
sCrit1 = filt.Criteria1
sCrit2 = filt.Criteria2
lngOp = filt.Operator
If lngOp = xlAnd Then
sop = " And "
ElseIf lngOp = xlOr Then
sop = " or "
Else
sop = ""
End If
ShowFilter = sCrit1 & sop & sCrit2
End If
End If
End Function

=ShowFilter(B5)&left(Subtotal(9,B5:B200),0)

would show the filter for column 2

I usually put these functions in cells above the filter

 

[Tom Ogilvy]

Here is a similar one I wrote: (from a post by Debra Dalgleish)

Tom Ogilvy posted the following function, that can be used to return the
criteria from a column in an autofiltered table. It will show both
criteria if there are two, and will include the operator.

Public Function ShowFilter(rng As Range)
'UDF that displays the filter criteria.
'posted by Tom Ogilvy 1/17/02
'To make it respond to a filter change, tie it to the subtotal command.
'=showfilter(B10)&CHAR(SUBTOTAL(9,B11)*0+32)
'So the above would show the criteria for column B

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
Set sh = rng.Parent
If sh.FilterMode = False Then
ShowFilter = "No Active Filter"
Exit Function
End If
Set frng = sh.AutoFilter.Range

If Intersect(rng.EntireColumn, frng) Is Nothing Then
ShowFilter = CVErr(xlErrRef)
Else
lngOff = rng.Column - frng.Columns(1).Column + 1
If Not sh.AutoFilter.Filters(lngOff).On Then
ShowFilter = "No Conditions"
Else
Set filt = sh.AutoFilter.Filters(lngOff)
On Error Resume Next
sCrit1 = filt.Criteria1
sCrit2 = filt.Criteria2
lngOp = filt.Operator
If lngOp = xlAnd Then
sop = " And "
ElseIf lngOp = xlOr Then
sop = " or "
Else
sop = ""
End If
ShowFilter = sCrit1 & sop & sCrit2
End If
End If
End Function


About the same as the first, but has some comments.

 

[Debra Dalgleish]

Instead of reusing the variables, create unique variables, and show
those on Sheet1 --

'=====================================
Private Sub CommandButton1_Click() 'Search for Comparable units'
Dim strCity As String
Dim strUnit As String
Dim dblMinBr As Double
Dim dblMaxBr As Double
Dim dblMinRent As Double
Dim dblMaxRent As Double
Dim intMinYear As Integer
Dim intMaxYear As Integer

On Error Resume Next
Sheets("Comparability_Data").ShowAllData

strCity = InputBox("Enter The CITY You Are Searching For:")
Sheets("Comparability_Data").UsedRange.AutoFilter Field:=2, _
Criteria1:="=*" & strCity & "*", Operator:=xlAnd

strUnit = InputBox("Enter The UNIT TYPE You Are Searching For:")
Sheets("Comparability_Data").UsedRange.AutoFilter Field:=3, _
Criteria1:="=*" & strUnit & "*", Operator:=xlAnd

dblMinBr = InputBox("Enter The MINIMUM BR SIZE Of Unit:")
dblMaxBr = InputBox("Enter The MAXIMUM BR SIZE Of Unit:")
Sheets("Comparability_Data").UsedRange.AutoFilter Field:=8, _
Criteria1:="<=" & dblMaxBr, Operator:=xlAnd, _
Criteria2:=">=" & dblMinBr

dblMinRent = InputBox("Enter The MINIMUM RENT AMOUNT You Are SearchingFor:")
dblMaxRent = InputBox("Enter The MAXIMUM RENT AMOUNT You Are Searching:")
Sheets("Comparability_Data").UsedRange.AutoFilter Field:=6, _
Criteria1:="<=" & dblMaxRent, Operator:=xlAnd, _
Criteria2:=">=" & dblMinRent

intMinYear = InputBox("Enter The MINIMUM YEAR BUILT of Unit:")
intMaxYear = InputBox("Enter The MAXIMUM YEAR BUILT Of Unit:")
Sheets("Comparability_Data").UsedRange.AutoFilter Field:=1, _
Criteria1:="<=" & intMaxYear, Operator:=xlAnd, _
Criteria2:=">=" & intMinYear

Sheets("sheet1").Range("A19:Ac39").Clear
Sheets("Comparability_Data").Range("a1:I16") _
.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets("sheet1").Range("a19")

'Unload UserForm2
With Sheets("SHEET1")
.Range("A15").Value = "Min"
.Range("A16").Value = "Max"
.Range("B14").Value = "City"
.Range("C14").Value = "Unit Type"
.Range("D14").Value = "Br Size"
.Range("E14").Value = "Rent"
.Range("F14").Value = "Year"
.Range("B15").Value = strCity
.Range("C15").Value = strUnit
.Range("D15").Value = dblMinBr
.Range("E15").Value = dblMinRent
.Range("F15").Value = intMinYear
.Range("D16").Value = dblMaxBr
.Range("E16").Value = dblMaxRent
.Range("F16").Value = intMaxYear
.Range("A1").Select
End With

End Sub
'======================================

 

[golf4]

Hi, Tom and Debra -

Thanks for your responses. I'll give your suggestions a try and let you know.

Thanks again,
Golf