R
ryguy7272
I am trying to create some kind of synthetic triple filter. I was hoping to
enter up to three values into a UserForm, paste all three values into a
certain sheet, and then copy and paste an entire row from one sheet to
another sheet, when these three (or two or just one) criteria are met. First
I copy data from a sheet named 'Primary' and paste it into a sheet named
'Filter'. Below is what I have so far:
Private Sub CommandButton1_Click()
Sheets("Primary").Activate
Sheets("Primary").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Filter").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Cells.Select
Selection.ClearContents
Range("A2").Select
Cells(2, 17) = TextBox1.Text
Cells(3, 17) = TextBox2.Text
Cells(4, 17) = TextBox3.Text
Sheets("Primary").Select
Dim i As Long
k = 1
Set r = ActiveSheet.UsedRange
nLastRow = r.Rows.Count + r.Row - 1
For i = 1 To nLastRow
If copydata(i) Then
Set rc = Cells(i, 5).EntireRow
Set rd = Sheets("Primary").Cells(k, 1) '< -- I think the problem is
here
Sheets("Filter").Select '< -- I think there is a problem here too
rc.Copy rd
k = k + 1
End If
Next
Unload UserForm1
End Sub
Function copydata(i As Long) As Boolean
Dim Val1
Dim Val2
Dim Val3
Val1 = Range("Q2")
Val2 = Range("Q3")
Val3 = Range("Q4")
copydata = False
For j = 1 To Columns.Count
If Cells(i, j).Text = Val1 Then
copydata = True
Exit Function
End If
Next
End Function
It was working fine with one criteria, but then I made some changes, to
accommodate the three items, and now nothing works. Is it even possible to
do what I propose? If so, how?
Regards,
Ryan--
enter up to three values into a UserForm, paste all three values into a
certain sheet, and then copy and paste an entire row from one sheet to
another sheet, when these three (or two or just one) criteria are met. First
I copy data from a sheet named 'Primary' and paste it into a sheet named
'Filter'. Below is what I have so far:
Private Sub CommandButton1_Click()
Sheets("Primary").Activate
Sheets("Primary").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Filter").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Cells.Select
Selection.ClearContents
Range("A2").Select
Cells(2, 17) = TextBox1.Text
Cells(3, 17) = TextBox2.Text
Cells(4, 17) = TextBox3.Text
Sheets("Primary").Select
Dim i As Long
k = 1
Set r = ActiveSheet.UsedRange
nLastRow = r.Rows.Count + r.Row - 1
For i = 1 To nLastRow
If copydata(i) Then
Set rc = Cells(i, 5).EntireRow
Set rd = Sheets("Primary").Cells(k, 1) '< -- I think the problem is
here
Sheets("Filter").Select '< -- I think there is a problem here too
rc.Copy rd
k = k + 1
End If
Next
Unload UserForm1
End Sub
Function copydata(i As Long) As Boolean
Dim Val1
Dim Val2
Dim Val3
Val1 = Range("Q2")
Val2 = Range("Q3")
Val3 = Range("Q4")
copydata = False
For j = 1 To Columns.Count
If Cells(i, j).Text = Val1 Then
copydata = True
Exit Function
End If
Next
End Function
It was working fine with one criteria, but then I made some changes, to
accommodate the three items, and now nothing works. Is it even possible to
do what I propose? If so, how?
Regards,
Ryan--