In a sheet I have two text boxes and a search button
when the user inputs some value into the text boxes and clicks the search
I want the data to be filtered....
I have started to write a macro and got stuck
any help ?
Private Sub Image1_Click()
Dim s As String
Dim p As String
s = TextBox1.Value
p = TextBox2.Value
Selection.AutoFilter Field:=5, Criteria1:=quot;gt;=5quot;, Operator:=xlAnd,
Criteria2:=quot;lt;=400quot;
end sub
Also in case of error.. like if the user doesnt type value in the boxes?
what codes goes ?I
Hi,
quot;any help?quot;
This is overkill but have a look at my homemade macro amp; function listed
below, because it is homemade it isn't totally bulletproof/polished but
considers some potential issues. It may be more detailed than you
require but I find it fast amp; very useful as it uses an input box rather
than textboxes for the search criteria amp; I have it stored in my
personal.xls amp; assigned to a shortcut key.
(I'm pretty sure this is the same as my newest version but can't
confirm, as that is in the office).
btw, The part commented with '*** shows how to allow for the search
being cancelled.
nb: there may be word wrap issues that need to be checked.
Sub EnhancedQuickFilterNEWer050306()
'written by Rob Brockett (NZ)
Application.ScreenUpdating = False
Dim ColToFilter As Long
ColToFilter = ActiveCell.Column
Dim InitialFilterValue As String
Dim FilterValue As String
Dim FilterValueDate As Date
Dim StringPrefix As String
Dim CurrentCellFormat As String
CurrentCellFormat = ActiveCell.NumberFormat
Dim DateCheck As Long
InitialFilterValue = InputBox(quot;SHORT CUT CODES:quot; amp; Chr(13) amp; Chr(13) amp;
_
quot;[BLANK] = Show all rows with/containing value of current cell.quot; amp;
Chr(13) amp; _
quot;[SPACE] = Show all rows in active column.quot; amp; Chr(13) amp; _
quot;[SPACE SPACE] = Show all rows in all columns.quot; amp; Chr(13) amp; _
quot;[SPACE SPACE SPACE] = Show all rows with blanks.quot; amp; Chr(13) amp; _
quot;[-] = Hide all rows with current cell value.quot; amp; Chr(13) amp; _
quot; = Hide all rows with blanks in this column.quot; amp; Chr(13) amp; _
quot;[lt;?] = Show all rows with values less than ?quot; amp; Chr(13) amp; _
quot;[gt;?] = Show all rows with values greater than ?quot; amp; Chr(13) amp; _
quot;[lt;] = Show all rows with values less than current cell or entered
value.quot; amp; Chr(13) amp; _
quot;[gt;] = Show all rows with values greater than current cell or entered
value.quot; amp; Chr(13) amp; Chr(13), quot;QUICK FILTERquot;)
'***To end sub if quot;cancelquot; was pressed sourced from _
www.excelforum.com/showthread...vbcancel input
amp; vb.mvps.org/tips/varptr.asp
If StrPtr(InitialFilterValue) = 0 Then
GoTo ExitSub
Else
End If
Select Case Len(InitialFilterValue)
Case 0
'ErrorCheckOfActiveCell
FilterValue = PossibleErrorCodeOfActiveCell
Selection.AutoFilter Field:=ColToFilter, Criteria1:=quot;=quot; amp;
FilterValue, Operator:=xlOr, _
Criteria2:=quot;=*quot; amp; FilterValue amp; quot;*quot;
GoTo ExitSub
Select Case Len(ActiveCell)
Case Is lt;gt; 0
'Checks if current cell is a date amp; shows FilterValue
of current cell _
using various methods
If IsDate(ActiveCell) Then
'***
RepeatedAttemptToFilterActiveCellByDate:
DateCheck = DateCheck 1
Select Case DateCheck
Case 1
FilterValue = ActiveCell
Case 2
FilterValue = CLng(CDate(ActiveCell))
Case 3
FilterValue =
Format(DateSerial(Year(ActiveCell), Month(ActiveCell),
Day(ActiveCell)), quot;dd/mm/yyquot;)
Case 4
FilterValue =
Format(DateSerial(Year(ActiveCell), Month(ActiveCell),
Day(ActiveCell)), quot;dd/mm/yyyyquot;)
Case 5
FilterValue =
Format(DateSerial(Year(ActiveCell), Month(ActiveCell),
Day(ActiveCell)), CurrentCellFormat)
Case 6
MsgBox quot;Date Filter not working, please use the
manual method of custom filtering.quot;
GoTo ExitSub
End Select
Else
FilterValue = ActiveCell
End If
Selection.AutoFilter Field:=ColToFilter,
Criteria1:=quot;=quot; amp; FilterValue
If ActiveCell.EntireRow.Hidden Then
If Len(InitialFilterValue) = 0 Then
GoTo RepeatedAttemptToFilterActiveCellByDate:
Else
End If
Else
End If
'***
Case 0
'Shows blank cells when active cell is empty
Selection.AutoFilter Field:=ColToFilter, Criteria1:=quot;=quot;
End Select
Case Else
Select Case Left(InitialFilterValue, 1)
Case quot; quot;
Select Case InitialFilterValue
Case quot; quot;
'show all in current column (1 space).
Selection.AutoFilter Field:=ColToFilter
GoTo ExitSub
Case quot; quot;
'To remove all any active filters on any filterable
column (2 spaces).
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
GoTo ExitSub
Case quot; quot;
'Shows blank cells when active cell is not empty (3
spaces).
Selection.AutoFilter Field:=ColToFilter,
Criteria1:=quot;=quot;
End Select
Case quot;lt;quot;
Select Case Left(InitialFilterValue, 2)
Case quot;lt;gt;quot;, quot;lt;=quot;
GoTo MakeStringPrefixDoubleLeft
Case Else
GoTo MakeStringPrefixSingleLeft
End Select
Case quot;gt;quot;
Select Case Left(InitialFilterValue, 2)
Case quot;gt;=quot;
GoTo MakeStringPrefixDoubleLeft
Case Else
GoTo MakeStringPrefixSingleLeft
End Select
Case quot;-quot;
Select Case InitialFilterValue
Case quot;-quot;
'Hide rows
FilterValue = PossibleErrorCodeOfActiveCell
Selection.AutoFilter Field:=ColToFilter,
Criteria1:=quot;lt;gt;quot; amp; FilterValue
Exit Sub
Case Else
'allows for filtering of negative values
GoTo MakeStringPrefixSingleLeft:
End Select
Case quot;*quot;
'Shows all non blanks (hides blanks)
Selection.AutoFilter Field:=ColToFilter, Criteria1:=quot;lt;gt;quot;
GoTo ExitSub
Case quot;=quot;
'To limit visible rows to exact matches
Select Case InitialFilterValue
Case quot;=quot;
FilterValue = PossibleErrorCodeOfActiveCell
Case Else
FilterValue = Right(InitialFilterValue,
Len(InitialFilterValue) - 1)
GoTo ExitSub
End Select
Selection.AutoFilter Field:=ColToFilter,
Criteria1:=FilterValue
Case Else
FilterValue = InitialFilterValue
GoTo ContinueAfterSettingStringPrefix
End Select
MakeStringPrefixSingleLeft:
StringPrefix = Left(InitialFilterValue, 1)
If Len(InitialFilterValue) = 1 Then
FilterValue = ActiveCell
Else
FilterValue = Right(InitialFilterValue, Len(InitialFilterValue) - 1)
End If
GoTo ContinueAfterSettingStringPrefix
MakeStringPrefixDoubleLeft:
StringPrefix = Left(InitialFilterValue, 2)
If Len(InitialFilterValue) = 2 Then
FilterValue = ActiveCell
Else
FilterValue = Right(InitialFilterValue, Len(InitialFilterValue) - 2)
End If
ContinueAfterSettingStringPrefix:
If StringPrefix = quot;lt;gt;quot; Then
Selection.AutoFilter Field:=ColToFilter, Criteria1:=StringPrefix amp;
FilterValue
Else
If StringPrefix = quot;-quot; Then
Selection.AutoFilter Field:=ColToFilter, Criteria1:=quot;lt;gt;quot; amp;
FilterValue, Operator:=xlOr, _
Criteria2:=quot;lt;gt;*quot; amp; FilterValue amp; quot;*quot;
Else
Selection.AutoFilter Field:=ColToFilter, Criteria1:=StringPrefix amp;
FilterValue, Operator:=xlOr, _
Criteria2:=quot;=*quot; amp; FilterValue amp; quot;*quot;
End If
End If
End Select
ExitSub:
Application.ScreenUpdating = True
End Sub
Public Function PossibleErrorCodeOfActiveCell()
'To allow filtering of cells with errors (the commented # to the _
right is the error value.
If IsError(ActiveCell) Then
Select Case ActiveCell
Case CVErr(xlErrDiv0) '2007
PossibleErrorCodeOfActiveCell = quot;#DIV/0!quot;
Case CVErr(xlErrNA) '2042
PossibleErrorCodeOfActiveCell = quot;#N/Aquot;
Case CVErr(xlErrName) '2029
PossibleErrorCodeOfActiveCell = quot;#NAME?quot;
Case CVErr(xlErrNull) '2000
PossibleErrorCodeOfActiveCell = quot;#NULL!quot;
Case CVErr(xlErrNum) '2036
PossibleErrorCodeOfActiveCell = quot;#NUM!quot;
Case CVErr(xlErrRef) '2023
PossibleErrorCodeOfActiveCell = quot;#REF!quot;
Case CVErr(xlErrValue) '2015
PossibleErrorCodeOfActiveCell = quot;#VALUE!quot;
End Select
Else
PossibleErrorCodeOfActiveCell = ActiveCell
End If
End Function
Please let me know if it helps/you have any suggestions.
hth,
Rob Brockett
NZ
Always learning amp; the best way to learn is to experience...--
broro183
------------------------------------------------------------------------
broro183's Profile: www.excelforum.com/member.php...oamp;userid=30068
View this thread: www.excelforum.com/showthread...hreadid=533724
- Jun 04 Wed 2008 20:44
autofilter macro
close
全站熱搜
留言列表
發表留言
留言列表

