I use this one code to find an item with six different criteria, is
there a better way to find an item with multiple criteria?

Sub Button1_Click()
Sheets("Sheet2").Range("G:G").ClearContents
Application.ScreenUpdating = False
Sheets("Sheet1").Range("A1").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = Worksheets("Sheet2").Range("A1") Then
If ActiveCell.Offset(0, 1).Value = Worksheets("Sheet2").Range("B2")
Then
If ActiveCell.Offset(0, 2).Value = Worksheets("Sheet2").Range("C2")
Then
If ActiveCell.Offset(0, 3).Value = Worksheets("Sheet2").Range("D2")
Then
If ActiveCell.Offset(0, 4).Value = Worksheets("Sheet2").Range("E2")
Then
If ActiveCell.Offset(0, 5).Value = Worksheets("Sheet2").Range("F2")
Then
Sheets("Sheet2").Range("G6000").End(xlUp).Offset(1 , 0) =
ActiveCell.Offset(0, 6)
End If
End If
End If
End If
End If
End If
ActiveCell.Offset(1, 0).Select
Loop


End Sub

Better to use the autofilter feature than to step through:

With Sheets("Sheet1").Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:=Worksheets("Sheet2").Range("A1").Value
.AutoFilter Field:=2, Criteria1:=Worksheets("Sheet2").Range("B2").Value
.AutoFilter Field:=3, Criteria1:=Worksheets("Sheet2").Range("C2").Value
.AutoFilter Field:=4, Criteria1:=Worksheets("Sheet2").Range("D2").Value
.AutoFilter Field:=5, Criteria1:=Worksheets("Sheet2").Range("E2").Value
.AutoFilter Field:=6, Criteria1:=Worksheets("Sheet2").Range("F2").Value
.Columns(7).SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet2").Range("G2")
.AutoFilter
End With

HTH,
Bernie
MS Excel MVP


"damorrison" wrote in message
ups.com...
I use this one code to find an item with six different criteria, is
there a better way to find an item with multiple criteria?

Sub Button1_Click()
Sheets("Sheet2").Range("G:G").ClearContents
Application.ScreenUpdating = False
Sheets("Sheet1").Range("A1").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = Worksheets("Sheet2").Range("A1") Then
If ActiveCell.Offset(0, 1).Value = Worksheets("Sheet2").Range("B2")
Then
If ActiveCell.Offset(0, 2).Value = Worksheets("Sheet2").Range("C2")
Then
If ActiveCell.Offset(0, 3).Value = Worksheets("Sheet2").Range("D2")
Then
If ActiveCell.Offset(0, 4).Value = Worksheets("Sheet2").Range("E2")
Then
If ActiveCell.Offset(0, 5).Value = Worksheets("Sheet2").Range("F2")
Then
Sheets("Sheet2").Range("G6000").End(xlUp).Offset(1 , 0) =
ActiveCell.Offset(0, 6)
End If
End If
End If
End If
End If
End If
ActiveCell.Offset(1, 0).Select
Loop


End Sub

Maybe you could just populate that cell with a formula.

Saved from a previous post:

If you want exact matches for just two columns (and return a value from a
third), you could use:

=index(othersheet!$c$1:$c$100,
match(1,(a2=othersheet!$a$1:$a$100)*(b2=othersheet !$b$1:$b$100),0))

(all in one cell)

This is an array formula. Hit ctrl-shift-enter instead of enter. If you do it
correctly, excel will wrap curly brackets {} around your formula. (don't type
them yourself.)

Adjust the range to match--but you can't use the whole column.

This returns the value in othersheet column C when column A and B (of
othersheet) match A2 and B2 of the sheet with the formula.

And you can add more conditions by just adding more stuff to that product
portion of the formula:

=index(othersheet!$d$1:$d$100,
match(1,(a2=othersheet!$a$1:$a$100)
*(b2=othersheet!$b$1:$b$100)
*(c2=othersheet!$c$1:$c$100),0))

=========
So in your case, it would look like:

=INDEX(Sheet1!$G$1:$G$999,
MATCH(1,($A$2=Sheet1!$A$1:$A$999)
*($B$2=Sheet1!$B$1:$B$999)
*($C$2=Sheet1!$C$1:$C$999)
*($D$2=Sheet1!$D$1:$D$999)
*($E$2=Sheet1!$E$1:$E$999)
*($F$2=Sheet1!$F$1:$F$999),0))

Change row 999 to something large enough to fit your data.

=============
If you actually needed a macro to create this formula, you could use something
like:

Option Explicit
Sub Button1_Click()

Dim myFormula As String
Dim LookupCell1 As Range
Dim TableCol1 As Range
Dim ColsToMatch As Long
Dim iCol As Long
Dim DestCell As Range

ColsToMatch = 6 'A:F

With Worksheets("sheet2")
Set LookupCell1 = .Range("a2")
Set DestCell = LookupCell1.Offset(0, ColsToMatch + 1)
End With

With Worksheets("sheet1")
Set TableCol1 = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
End With

myFormula = ""
For iCol = 1 To ColsToMatch
myFormula = myFormula & _
"*(" & LookupCell1.Offset(0, iCol - 1) _
.Address(external:=True) & "=" _
& TableCol1.Offset(, iCol - 1) _
.Address(external:=True) & ")"
Next iCol

myFormula = Mid(myFormula, 2)
myFormula = "=index(" & TableCol1.Offset(, ColsToMatch) _
.Address(external:=True) & ",match(1," & myFormula & ",0))"

With DestCell
.Formula = myFormula
.FormulaArray = .Formula
'convert to values?
'.copy
'.pastespecial paste:=xlpastevalues
End With

End Sub

damorrison wrote:

I use this one code to find an item with six different criteria, is
there a better way to find an item with multiple criteria?

Sub Button1_Click()
Sheets("Sheet2").Range("G:G").ClearContents
Application.ScreenUpdating = False
Sheets("Sheet1").Range("A1").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = Worksheets("Sheet2").Range("A1") Then
If ActiveCell.Offset(0, 1).Value = Worksheets("Sheet2").Range("B2")
Then
If ActiveCell.Offset(0, 2).Value = Worksheets("Sheet2").Range("C2")
Then
If ActiveCell.Offset(0, 3).Value = Worksheets("Sheet2").Range("D2")
Then
If ActiveCell.Offset(0, 4).Value = Worksheets("Sheet2").Range("E2")
Then
If ActiveCell.Offset(0, 5).Value = Worksheets("Sheet2").Range("F2")
Then
Sheets("Sheet2").Range("G6000").End(xlUp).Offset(1 , 0) =
ActiveCell.Offset(0, 6)
End If
End If
End If
End If
End If
End If
ActiveCell.Offset(1, 0).Select
Loop

End Sub

--

Dave Peterson

thank you very much for this option, there is some flaw though,

It wants to paste the first item on the list in row 1 sheet1 all the
time into sheet2 column g then it pastes the correct data below


Sub Button1_Click()

Worksheets("Sheet2").Range("G:G").ClearContents
With Sheets("Sheet1").Range("A2").CurrentRegion
.AutoFilter Field:=1,
Criteria1:=Worksheets("Sheet2").Range("A2").Value
.AutoFilter Field:=2,
Criteria1:=Worksheets("Sheet2").Range("B2").Value
.AutoFilter Field:=3,
Criteria1:=Worksheets("Sheet2").Range("C2").Value
.AutoFilter Field:=4,
Criteria1:=Worksheets("Sheet2").Range("D2").Value
.AutoFilter Field:=5,
Criteria1:=Worksheets("Sheet2").Range("E2").Value
.AutoFilter Field:=6,
Criteria1:=Worksheets("Sheet2").Range("F2").Value
.Columns(7).SpecialCells(xlCellTypeVisible).Copy
Sheets("Sheet2").Range("G2")
.AutoFilter
End With
End Sub

Thanks dave,
how can I set up the formula to show all the data, that matches that
criteria,
this one works great to find the first match

Row 1 is the headers - in my tests, I used blanks. IF you never want the
first row, you can fix that by changing

..Columns(7).SpecialCells(xlCellTypeVisible).Copy
Sheets("Sheet2").Range("G2")


to

..Columns(7).Offset(1,0).SpecialCells(xlCellTypeVi sible).Copy
Sheets("Sheet2").Range("G2")

HTH,
Bernie
MS Excel MVP




"damorrison" wrote in message
ups.com...
thank you very much for this option, there is some flaw though,

It wants to paste the first item on the list in row 1 sheet1 all the
time into sheet2 column g then it pastes the correct data below


Sub Button1_Click()

Worksheets("Sheet2").Range("G:G").ClearContents
With Sheets("Sheet1").Range("A2").CurrentRegion
.AutoFilter Field:=1,
Criteria1:=Worksheets("Sheet2").Range("A2").Value
.AutoFilter Field:=2,
Criteria1:=Worksheets("Sheet2").Range("B2").Value
.AutoFilter Field:=3,
Criteria1:=Worksheets("Sheet2").Range("C2").Value
.AutoFilter Field:=4,
Criteria1:=Worksheets("Sheet2").Range("D2").Value
.AutoFilter Field:=5,
Criteria1:=Worksheets("Sheet2").Range("E2").Value
.AutoFilter Field:=6,
Criteria1:=Worksheets("Sheet2").Range("F2").Value
.Columns(7).SpecialCells(xlCellTypeVisible).Copy
Sheets("Sheet2").Range("G2")
.AutoFilter
End With
End Sub

This kind of formula (just like =vlookup()) returns only one value.



damorrison wrote:

Thanks dave,
how can I set up the formula to show all the data, that matches that
criteria,
this one works great to find the first match

--

Dave Peterson

OR change

.Columns(7).SpecialCells(xlCellTypeVisible).Copy
Sheets("Sheet2").Range("G2")

to

.Columns(7).SpecialCells(xlCellTypeVisible).Copy
Sheets("Sheet2").Range("G1")
Sheets("Sheet2").Range("G1").ClearContents

Bernie


"damorrison" wrote in message
ups.com...
thank you very much for this option, there is some flaw though,

It wants to paste the first item on the list in row 1 sheet1 all the
time into sheet2 column g then it pastes the correct data below


Sub Button1_Click()

Worksheets("Sheet2").Range("G:G").ClearContents
With Sheets("Sheet1").Range("A2").CurrentRegion
.AutoFilter Field:=1,
Criteria1:=Worksheets("Sheet2").Range("A2").Value
.AutoFilter Field:=2,
Criteria1:=Worksheets("Sheet2").Range("B2").Value
.AutoFilter Field:=3,
Criteria1:=Worksheets("Sheet2").Range("C2").Value
.AutoFilter Field:=4,
Criteria1:=Worksheets("Sheet2").Range("D2").Value
.AutoFilter Field:=5,
Criteria1:=Worksheets("Sheet2").Range("E2").Value
.AutoFilter Field:=6,
Criteria1:=Worksheets("Sheet2").Range("F2").Value
.Columns(7).SpecialCells(xlCellTypeVisible).Copy
Sheets("Sheet2").Range("G2")
.AutoFilter
End With
End Sub

That does the trick, thankyou very much