Array looping, increase speed of array macro

You could do it like this:

 Range("G2:G" & Range("G" & rows.count).end(xlup).row).formulaarray = _
"=INDEX(Sheet2!R8C4:R" & Range("D" & rows.count).end(xlup).row & "C4, MATCH(1,(RC[-6]=Sheet2!R8C1:R" & Range("A" & rows.count).end(xlup).row & "C1)*(RC[-5]=Sheet2!R8C5:R2" & Range("E" & rows.count).end(xlup).row & "C5),0))"

?

Thanks Yudlugar but this did not work.

I may not be clear in my statement, The macro works, I need it to loop or in some form work faster without brining my CPU useage to 100%. The macro you provided replaces my header (G1) and only returns the same value that was placed in my header in (G2). If I can provide more information please let me know.

I'm not sure if there is a quicker way than the worksheet fucntions. You could maybe try something along the lines of this, based on using find to loop through the data but dependant on what your data is like it might not be any better.

Sub macro4_1()
Dim lrow, count, counta
application.screenupdating = false
lrow = Range("A" & Rows.count).End(xlUp).Row
For count = 2 To lrow
    Set counta = Sheets("Sheet2").Range("A:A").Find(Range("a" & count))
    Do Until counta Is Nothing
        If Sheets("Sheet2").Range("E" & counta.Row) = Range("B" & count) Then
            Range("G" & count) = Sheets("Sheet2").Range("D" & counta.Row)
        End If
        Set counta = FindNext(counta)
    Loop
Next
application.screenupdating = true
End Sub

Thanks again Yudlugar,

Can you show me how to put that in with my code?

It was to replace your code.

I receive a compile error on this line, says "Sub or Function not defined"


Set counta = FindNext(counta)

Error on FindNext

try changing it to:
set counta = Sheets("Sheet2").Range("A:A").findnext(counta)

I really appreciate all your work, however this code actually returns a Run-time error2013-11-25_0948.png

Can you upload a sample workbook please.

Click go advanced and then "manage attachments"

Sub macro4_1()
Dim lrow, count, counta, ws1, ws2
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Application.ScreenUpdating = False
lrow = ws1.Range("A" & Rows.count).End(xlUp).Row
For count = 2 To lrow
    Set counta = ws2.Range("A:A").Find(ws1.Range("a" & count))
    Do Until counta Is Nothing
        If Sheets("Sheet2").Range("E" & counta.Row) = ws1.Range("B" & count) Then
            ws1.Range("G" & count) = Sheets("Sheet2").Range("D" & counta.Row)
            Exit Do
        End If
        On Error GoTo next_cell
        Set counta = ws2.Range("A:A").FindNext(counta)
        On Error GoTo 0
    Loop
next_cell:
Next
Application.ScreenUpdating = True
End Sub

That seems to work on your example.

At a large scale it seems to work a little faster, its not eating up the processor as much as the old one did. Thanks again, I'll see what I can manage.

Yudlugar,

It seems to lock up if data in sheet 1 is not found on sheet 2. Is there an else statement I can put in there?

You could maybe try putting a counter in and then exiting if it has searched more than the count, for example

Sub macro4_1()
Dim lrow, count, counta, ws1, ws2,i
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Application.ScreenUpdating = False
lrow = ws1.Range("A" & Rows.count).End(xlUp).Row
For count = 2 To lrow
    i = 1
    Set counta = ws2.Range("A:A").Find(ws1.Range("a" & count))
    Do Until counta Is Nothing or i >500
        If Sheets("Sheet2").Range("E" & counta.Row) = ws1.Range("B" & count) Then
            ws1.Range("G" & count) = Sheets("Sheet2").Range("D" & counta.Row)
            Exit Do
        End If
        On Error GoTo next_cell
        Set counta = ws2.Range("A:A").FindNext(counta)
        On Error GoTo 0
        i = i+1
    Loop
next_cell:
Next
Application.ScreenUpdating = True
End Sub

change i>500 as neccessary