find with six different criteria

[damorrison]

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

 

[Bernie Deitrick]

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

 

[Dave Peterson]

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]

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

 

[damorrison]

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

 

[Bernie Deitrick]

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(xlCellTypeVisible).Copy
Sheets("Sheet2").Range("G2")

HTH,
Bernie
MS Excel MVP

 

[Dave Peterson]

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

 

[Bernie Deitrick]

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]

That does the trick, thankyou very much