PDA

View Full Version : Help with macro code found on this forum



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

mdmackillop
04-24-2013, 12:15 PM
Welcome to VBAX,
Can you please repost your code, using the green VBA button to format it

caseystein
04-24-2013, 12:26 PM
'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 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

mdmackillop
04-24-2013, 12:31 PM
Can you post a file with sample data. Use Manage Attachments in the Go Advanced reply section