This formula in Sheet2!A1 and copied down to A10,000 seems to work
instantly on my machine.
=IF(B1=Sheet1!B1,IF(C1=Sheet1!C1,IF(D1=Sheet1!D1,I F(E1=Sheet1!E1,IF(F1=Sheet1!F1,IF(G1=Sheet1!G1,"MA TCH","no"),"no"),"no"),"no"),"no"),"no")
Do you really need VBA to do what you want?

Lawlera wrote:
Hi,

I am trying to compare rows of data and assign a value in col A for matching data. The trouble is the code I have seems to take an age. I have c. 10,000 rows of data in each sheet and if I am to resolve this query before I retire I will need some help!
The code I have is:

Sub loophilite()
Application.ScreenUpdating = False
Dim target, target1, target2 As Variant
Dim target3, target4, target5 As Variant
For a = 1 To 100 'ActiveSheet.UsedRange.SpecialCells(xlLastCell).Ro w
target = Sheets(1).Cells(a, 2).Value
target1 = Sheets(1).Cells(a, 4).Value
target2 = Sheets(1).Cells(a, 5).Value
target3 = Sheets(1).Cells(a, 6).Value
target4 = Sheets(1).Cells(a, 7).Value
target5 = Sheets(1).Cells(a, 8).Value

For b = 1 To Sheets(2).UsedRange.SpecialCells(xlLastCell).Row
If _
target = Sheets(2).Cells(b, 2).Value And _
target1 = Sheets(2).Cells(b, 4).Value And _
target2 = Sheets(2).Cells(b, 5).Value And _
target3 = Sheets(2).Cells(b, 6).Value And _
target4 = Sheets(2).Cells(b, 7).Value And _
target5 = Sheets(2).Cells(b, 8).Value _
Then Sheets(2).Cells(b, 1).Value = b: Sheets(1).Cells(a, 1).Value = b

Next b

Next a
Application.ScreenUpdating = True

End Sub

TIA

Thanks for the input but I need VBA because the match may not occur on the corresponding row in sheet2 and consequently I need to scan all entries lokking for a match.

Here is something quick and dirty. This loads both ranges into an Array.
Because there is a gap in Column C, this first fills it with the value 1.
It then uses the Correl function to see if both arrays are equal. If equal
(1) then the solution array (Sol1 & Sol2) are given the value of B.
Again, just quick and dirty. Just a general idea you will have to adjust.
HTH.

Sub Demo()
Dim s1
Dim s2
Dim a
Dim b
Dim Sol1()
Dim Sol2()

s1 = Sheets("Sheet1").[B1:H10]
s2 = Sheets("Sheet2").[B1:H10]

ReDim Sol1(1 To UBound(s1))
ReDim Sol2(1 To UBound(s2))

With WorksheetFunction

'// Fix gap in column C with '1'
For a = 1 To UBound(s1, 1)
s1(a, 2) = 1
Next a
For a = 1 To UBound(s2, 1)
s2(a, 2) = 1
Next a

'// Continue w/ loops
For a = 1 To UBound(s1, 1)
For b = 1 To UBound(s2, 1)

If .Correl(.Index(s1, a, 0), .Index(s2, b, 0)) = 1 Then
Sol1(a) = b
Sol2(b) = b
Exit For
End If
Next b
Next a

Sheets("Sheet1").[A1].Resize(UBound(s1, 1)) = .Transpose(Sol1)
Sheets("Sheet2").[A1].Resize(UBound(s2, 1)) = .Transpose(Sol2)
End With
End Sub

--
Dana DeLouis
Using Windows XP & Office XP
= = = = = = = = = = = = = = = = =


"Lawlera" wrote in message
...
Thanks for the input but I need VBA because the match may not occur on the
corresponding row in sheet2 and consequently I need to scan all entries
lokking for a match.