#1   Report Post  
Posted to microsoft.public.excel.misc
flow23
 
Posts: n/a
Default autofilter macro

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:="=5", Operator:=xlAnd,
Criteria2:="<=400"
end sub

Also in case of error.. like if the user doesnt type value in the boxes?
what codes goes ?I
  #2   Report Post  
Posted to microsoft.public.excel.misc
broro183
 
Posts: n/a
Default autofilter macro


Hi,

"any help?"
This is overkill but have a look at my homemade macro & 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 & very useful as it uses an input box rather
than textboxes for the search criteria & I have it stored in my
personal.xls & 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("SHORT CUT CODES:" & Chr(13) & Chr(13) &
_
"[BLANK] = Show all rows with/containing value of current cell." &
Chr(13) & _
"[SPACE] = Show all rows in active column." & Chr(13) & _
"[SPACE SPACE] = Show all rows in all columns." & Chr(13) & _
"[SPACE SPACE SPACE] = Show all rows with blanks." & Chr(13) & _
"[-] = Hide all rows with current cell value." & Chr(13) & _
" = Hide all rows with blanks in this column." & Chr(13) & _
"[<?] = Show all rows with values less than ?" & Chr(13) & _
"[?] = Show all rows with values greater than ?" & Chr(13) & _
"[<] = Show all rows with values less than current cell or entered
value." & Chr(13) & _
"[] = Show all rows with values greater than current cell or entered
value." & Chr(13) & Chr(13), "QUICK FILTER")

'***To end sub if "cancel" was pressed sourced from _
http://www.excelforum.com/showthread...vbcancel+input
& http://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:="=" &
FilterValue, Operator:=xlOr, _
Criteria2:="=*" & FilterValue & "*"
GoTo ExitSub
Select Case Len(ActiveCell)
Case Is < 0
'Checks if current cell is a date & 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)), "dd/mm/yy")
Case 4
FilterValue =
Format(DateSerial(Year(ActiveCell), Month(ActiveCell),
Day(ActiveCell)), "dd/mm/yyyy")
Case 5
FilterValue =
Format(DateSerial(Year(ActiveCell), Month(ActiveCell),
Day(ActiveCell)), CurrentCellFormat)
Case 6
MsgBox "Date Filter not working, please use the
manual method of custom filtering."
GoTo ExitSub
End Select
Else
FilterValue = ActiveCell
End If
Selection.AutoFilter Field:=ColToFilter,
Criteria1:="=" & 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:="="
End Select
Case Else
Select Case Left(InitialFilterValue, 1)
Case " "
Select Case InitialFilterValue
Case " "
'show all in current column (1 space).
Selection.AutoFilter Field:=ColToFilter
GoTo ExitSub
Case " "
'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 " "
'Shows blank cells when active cell is not empty (3
spaces).
Selection.AutoFilter Field:=ColToFilter,
Criteria1:="="
End Select
Case "<"
Select Case Left(InitialFilterValue, 2)
Case "<", "<="
GoTo MakeStringPrefixDoubleLeft
Case Else
GoTo MakeStringPrefixSingleLeft
End Select
Case ""
Select Case Left(InitialFilterValue, 2)
Case "="
GoTo MakeStringPrefixDoubleLeft
Case Else
GoTo MakeStringPrefixSingleLeft
End Select
Case "-"
Select Case InitialFilterValue
Case "-"
'Hide rows
FilterValue = PossibleErrorCodeOfActiveCell
Selection.AutoFilter Field:=ColToFilter,
Criteria1:="<" & FilterValue
Exit Sub
Case Else
'allows for filtering of negative values
GoTo MakeStringPrefixSingleLeft:
End Select
Case "*"
'Shows all non blanks (hides blanks)
Selection.AutoFilter Field:=ColToFilter, Criteria1:="<"
GoTo ExitSub
Case "="
'To limit visible rows to exact matches
Select Case InitialFilterValue
Case "="
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 = "<" Then
Selection.AutoFilter Field:=ColToFilter, Criteria1:=StringPrefix &
FilterValue
Else
If StringPrefix = "-" Then
Selection.AutoFilter Field:=ColToFilter, Criteria1:="<" &
FilterValue, Operator:=xlOr, _
Criteria2:="<*" & FilterValue & "*"
Else
Selection.AutoFilter Field:=ColToFilter, Criteria1:=StringPrefix &
FilterValue, Operator:=xlOr, _
Criteria2:="=*" & FilterValue & "*"
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 = "#DIV/0!"
Case CVErr(xlErrNA) '2042
PossibleErrorCodeOfActiveCell = "#N/A"
Case CVErr(xlErrName) '2029
PossibleErrorCodeOfActiveCell = "#NAME?"
Case CVErr(xlErrNull) '2000
PossibleErrorCodeOfActiveCell = "#NULL!"
Case CVErr(xlErrNum) '2036
PossibleErrorCodeOfActiveCell = "#NUM!"
Case CVErr(xlErrRef) '2023
PossibleErrorCodeOfActiveCell = "#REF!"
Case CVErr(xlErrValue) '2015
PossibleErrorCodeOfActiveCell = "#VALUE!"
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 & the best way to learn is to experience...


--
broro183
------------------------------------------------------------------------
broro183's Profile: http://www.excelforum.com/member.php...o&userid=30068
View this thread: http://www.excelforum.com/showthread...hreadid=533724

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
macro with F9 Kenny Excel Discussion (Misc queries) 1 August 3rd 05 02:41 PM
Make Alignment options under format cells available as shortcut dforrest Excel Discussion (Misc queries) 1 July 14th 05 10:58 PM
Keep autofilter after macro is run gmr7 Excel Worksheet Functions 2 July 5th 05 01:16 PM
Loop Macro autofilter Paul. Excel Discussion (Misc queries) 2 March 25th 05 09:35 AM
Playing a macro from another workbook Jim Excel Discussion (Misc queries) 1 February 23rd 05 10:12 PM


All times are GMT +1. The time now is 01:27 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"