levak.bob
10-03-2012, 10:51 PM
Hi
I was wondering if someone could help me.
I need to add two more criteria via Textbox (from date - to date) filter
the code: from gibbo1715
Option Explicit
Function FilterAndCopy(rng As Range, Choice As String)
Dim FiltRng As Range
'Clear Contents to show just new search data
Worksheets("Sheet2").Cells.ClearContents
'Set the column to filter (In This Case 1 or A)
'Change as required
rng.AutoFilter Field:=1, Criteria1:=Choice
On Error Resume Next
Set FiltRng = rng.SpecialCells(xlCellTypeVisible).EntireRow
On Error Goto 0
'Copy Data across to sheet 2
FiltRng.Copy Worksheets("Sheet2").Range("A1")
'Display Data
Worksheets("Sheet2").Select
Range("A1").Select
Set FiltRng = Nothing
End Function
Sub formshow()
'Show Search Form
UserForm1.Show
End Sub
'*****************************************************************
'In a userform
Option Explicit
Private Sub CommandButton1_Click()
Dim rng As Range
'Set Error Handling
On Error Goto ws_exit:
Application.EnableEvents = False
'Set Range
Set rng = ActiveSheet.UsedRange
'Cancel if no value entered in textbox
If TextBox1.Value = "" Then Goto ws_exit:
'Call function Filterandcopy
FilterAndCopy rng, TextBox1.Value
rng.AutoFilter
'Exit sub
ws_exit:
Set rng = Nothing
Application.EnableEvents = True
Unload Me
End Sub
Private Sub CommandButton2_Click()
'Cancel Button
Unload Me
End Sub
Thanks very much in advance
I was wondering if someone could help me.
I need to add two more criteria via Textbox (from date - to date) filter
the code: from gibbo1715
Option Explicit
Function FilterAndCopy(rng As Range, Choice As String)
Dim FiltRng As Range
'Clear Contents to show just new search data
Worksheets("Sheet2").Cells.ClearContents
'Set the column to filter (In This Case 1 or A)
'Change as required
rng.AutoFilter Field:=1, Criteria1:=Choice
On Error Resume Next
Set FiltRng = rng.SpecialCells(xlCellTypeVisible).EntireRow
On Error Goto 0
'Copy Data across to sheet 2
FiltRng.Copy Worksheets("Sheet2").Range("A1")
'Display Data
Worksheets("Sheet2").Select
Range("A1").Select
Set FiltRng = Nothing
End Function
Sub formshow()
'Show Search Form
UserForm1.Show
End Sub
'*****************************************************************
'In a userform
Option Explicit
Private Sub CommandButton1_Click()
Dim rng As Range
'Set Error Handling
On Error Goto ws_exit:
Application.EnableEvents = False
'Set Range
Set rng = ActiveSheet.UsedRange
'Cancel if no value entered in textbox
If TextBox1.Value = "" Then Goto ws_exit:
'Call function Filterandcopy
FilterAndCopy rng, TextBox1.Value
rng.AutoFilter
'Exit sub
ws_exit:
Set rng = Nothing
Application.EnableEvents = True
Unload Me
End Sub
Private Sub CommandButton2_Click()
'Cancel Button
Unload Me
End Sub
Thanks very much in advance