Triple Filter

[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--

 

[ryguy7272]

Code below ALMOST works for for one criteria...but I get a few extra items at
the bottom:
Private Sub CommandButton1_Click()
Sheets("Filter").Select
Cells.Select
Selection.ClearContents

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(1, 17) = TextBox1.Text
Cells(1, 18) = TextBox2.Text
Cells(1, 19) = TextBox3.Text


Dim i As Long
k = 1
Set r = ActiveSheet.UsedRange
nLastRow = r.Rows.Count + r.Row - 1
For i = 1 To nLastRow
If filt(i) Then
Set rc = Cells(i, 5).EntireRow
Set rd = Sheets("Filter").Cells(k, 1)
rc.Copy rd
k = k + 1
End If
Next
Unload UserForm1
End Sub


Function filt(i As Long) As Boolean
filt = False
For j = 1 To Columns.Count
If Cells(i, j).Text = Range("Q1") Then
filt = True
Exit Function
End If
Next
End Function

Still at a loss as to how to handle three criteria simultaneously.
I'd really appreciate any help.

Regards,
Ryan--

 

[ryguy7272]

Problem resolved!
I created a UserForm with three TextBoxes and one CommandButton:

Private Sub CommandButton1_Click()
Dim a As Variant
Dim b As Variant
Dim c As Variant


Sheets("Filter").Select
Cells.Select
Selection.ClearContents
Range("A1").Select


Cells(1, 17) = TextBox1.Text
Cells(1, 18) = TextBox2.Text
Cells(1, 19) = TextBox3.Text

a = Range("Q1")
b = Range("R1")
c = Range("S1")

Sheets("Primary").Select
Range("A1").Select

Cells.Select
Application.CutCopyMode = False
Selection.AutoFilter
Rows("1:1").Select
Selection.AutoFilter

Selection.AutoFilter Field:=5, Criteria1:=a
If Sheets("Filter").Range("R1") = "" Then
Selection.AutoFilter Field:=6
Else
Selection.AutoFilter Field:=6, Criteria1:=b
If Sheets("Filter").Range("S1") = "" Then
Selection.AutoFilter Field:=8
Else
Selection.AutoFilter Field:=8, Criteria1:=c
End If
End If

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


Unload UserForm1
End Sub

All code is contained within the UserForm.

Maybe others will benefit from this...

Regards,
Ryan--