caseystein
04-24-2013, 11:17 AM
Hi, I need to simple modification to a macro I g=found here on this forum.
The macro currently works on one condition which is entered on a user form...I want it to work based on 2 conditions (column B and Column C)...both of which I can be enter on a user form. Thanks in advance for any help:
'In a Standard Module 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 HandlingOn Error Goto ws_exit: Application.EnableEvents = False 'Set Range Set rng = ActiveSheet.UsedRange 'Cancel if no value entered in textboxIf TextBox1.Value = "" Then Goto ws_exit: 'Call function Filterandcopy FilterAndCopy rng, TextBox1.Value rng.AutoFilter 'Exit subws_exit: Set rng = Nothing Application.EnableEvents = True Unload Me End Sub Private Sub CommandButton2_Click() 'Cancel Button Unload Me End Sub
The macro currently works on one condition which is entered on a user form...I want it to work based on 2 conditions (column B and Column C)...both of which I can be enter on a user form. Thanks in advance for any help:
'In a Standard Module 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 HandlingOn Error Goto ws_exit: Application.EnableEvents = False 'Set Range Set rng = ActiveSheet.UsedRange 'Cancel if no value entered in textboxIf TextBox1.Value = "" Then Goto ws_exit: 'Call function Filterandcopy FilterAndCopy rng, TextBox1.Value rng.AutoFilter 'Exit subws_exit: Set rng = Nothing Application.EnableEvents = True Unload Me End Sub Private Sub CommandButton2_Click() 'Cancel Button Unload Me End Sub