For loop very bad performance

[bydo]

Hello,


I am matching about 22,000 IDs with a 55,000 row huge inventory. On hit I will check another column for a value and write down the findings in a third table.


My problem is, that this procedure will take more than 20 minutes (I canceled it there). Why is it taking so long and how can I improve the performance?


An exemplary table with code is enclosed, thanks in advance and regards


Bydo

[Bob Phillips]

Try this


Public Sub FormatOutput()
Dim lastrow As Long

Application.ScreenUpdating = False

lastrow = Worksheets("Prüfliste").Range("A" & Rows.Count).End(xlUp).Row
With Worksheets("Ausgabe")

.Range("A2").Resize(lastrow - 1).FormulaR1C1 = "=Prüfliste!RC"
.Range("B2").Resize(lastrow - 1).Value = Format(Now, "DD.MM.YYYY HH:MM")
.Range("C2").Resize(lastrow - 1).Value = "bydo@vba.ms"
.Range("D2").Resize(lastrow - 1).Value = "bydo"
.Range("E2").Resize(lastrow - 1).FormulaR1C1 = _
"=IF(ISNA(MATCH(Prüfliste!RC[-3],Inventar!C[-2],0)),MATCH(Prüfliste!RC[-3],Inventar!C[-1],0),MATCH(Prüfliste!RC[-3],Inventar!C[-2],0))"
.Range("F2").Resize(lastrow - 1).FormulaR1C1 = _
"=IF(ISNA(RC5),""nicht gefunden"",IF(OR(INDEX(Inventar!C6,RC5)=""aktiv"",INDEX(Inventar!C6,RC5)=""wartend""),"""",INDEX(Inventar!C[-4],RC5)))"
.Range("G2").Resize(lastrow - 1).FormulaR1C1 = _
"=IF(ISNA(RC5),""nicht gefunden"",IF(OR(INDEX(Inventar!C6,RC5)=""aktiv"",INDEX(Inventar!C6,RC5)=""wartend""),"""",INDEX(Inventar!C[-2],RC5)))"
.Range("H2").Resize(lastrow - 1).FormulaR1C1 = _
"=IF(ISNA(RC5),""nicht gefunden"",IF(OR(INDEX(Inventar!C6,RC5)=""aktiv"",INDEX(Inventar!C6,RC5)=""wartend""),"""",INDEX(Inventar!C[-2],RC5)))"

With .Range("A2").Resize(lastrow - 1, 8)

.Value = .Value
End With

.Columns("E:E").Delete
End With

Application.ScreenUpdating = True
End Sub

[SamT]

The Code from your attachement:

Sub FORIFIF()
Dim CHECKROW As Long
Dim INVENTROW As Long
Dim OUTPUTROW As Long

Application.ScreenUpdating = False

OUTPUTROW = 1

For CHECKROW = Sheets("Prüfliste").Range("A" & Rows.Count).End(3)(1).Row To 2 Step -1
OUTPUTROW = OUTPUTROW + 1
Sheets("Ausgabe").Cells(OUTPUTROW, 1).Value = Sheets("Prüfliste").Cells(CHECKROW, 1).Value
Sheets("Ausgabe").Cells(OUTPUTROW, 2).Value = Format(Now, "DD.MM.YYYY HH:MM")
Sheets("Ausgabe").Cells(OUTPUTROW, 3).Value = "bydo@vba.ms"
Sheets("Ausgabe").Cells(OUTPUTROW, 4).Value = "bydo"
For INVENTROW = Sheets("Inventar").Range("A" & Rows.Count).End(3)(1).Row To 2 Step -1
If Sheets("Inventar").Cells(INVENTROW, 3).Value = Sheets("Prüfliste").Cells(CHECKROW, 2).Value Then
If Sheets("Inventar").Cells(INVENTROW, 6).Value = "aktiv" Or Sheets("Inventar").Cells(INVENTROW, 6).Value = "wartend" Then
Exit For
Else
Sheets("Ausgabe").Cells(OUTPUTROW, 5).Value = Sheets("Inventar").Cells(INVENTROW, 2).Value
Sheets("Ausgabe").Cells(OUTPUTROW, 6).Value = Sheets("Inventar").Cells(INVENTROW, 5).Value
Sheets("Ausgabe").Cells(OUTPUTROW, 7).Value = Sheets("Inventar").Cells(INVENTROW, 6).Value
Exit For
End If
End If
If Sheets("Inventar").Cells(INVENTROW, 4).Value = Sheets("Prüfliste").Cells(CHECKROW, 2).Value Then
If Sheets("Inventar").Cells(INVENTROW, 6).Value = "aktiv" Or Sheets("Inventar").Cells(INVENTROW, 6).Value = "wartend" Then
Exit For
Else
Sheets("Ausgabe").Cells(OUTPUTROW, 5).Value = Sheets("Inventar").Cells(INVENTROW, 2).Value
Sheets("Ausgabe").Cells(OUTPUTROW, 6).Value = Sheets("Inventar").Cells(INVENTROW, 5).Value
Sheets("Ausgabe").Cells(OUTPUTROW, 7).Value = Sheets("Inventar").Cells(INVENTROW, 6).Value
Exit For
End If
End If
If INVENTROW = 2 Then
Sheets("Ausgabe").Cells(OUTPUTROW, 5).Value = "nicht gefunden"
Sheets("Ausgabe").Cells(OUTPUTROW, 6).Value = "nicht gefunden"
Sheets("Ausgabe").Cells(OUTPUTROW, 7).Value = "nicht gefunden"
End If
Next INVENTROW
Next CHECKROW

Application.ScreenUpdating = True

End Sub


I think we can make that 5500 times faster

[SamT]

Here's what I came up with

Sub FORIFIF()
Dim CheckRow As Long
Dim OutRow As Long
Dim Ausgabe As Object
Dim Inventar As Object
Dim Prüfliste As Object
Dim InventCallSigns As Range
Dim Found As Range

Set Prüfliste = Sheets("Prüfliste")
Set Inventar = Sheets("Inventar")
Set Ausgabe = Sheets("Ausgabe")
Set InventCallSigns = Inventar.Range("C:D")
OutRow = 1

Application.ScreenUpdating = False

For CheckRow = Prüfliste.Range("A" & Rows.Count).End(3)(1).Row To 2 Step -1
Ausgabe.Cells(OutRow, 1).Value = Prüfliste.Cells(CheckRow, 1).Value
Ausgabe.Cells(OutRow, 2).Value = Format(Now, "DD.MM.YYYY HH:MM")
Ausgabe.Cells(OutRow, 3).Value = "bydo@vba.ms"
Ausgabe.Cells(OutRow, 4).Value = "bydo"

OutRow = OutRow + 1

Set Found = InventCallSigns.Find(Prüfliste.Cells(CheckRow, 2))
If Found Is Nothing Then
Ausgabe.Cells(OutRow, 5).Value = "nicht gefunden"
Ausgabe.Cells(OutRow, 6).Value = "nicht gefunden"
Ausgabe.Cells(OutRow, 7).Value = "nicht gefunden"
Else
With Inventar.Rows(Found.Row)
If .Cells(6) <> "aktiv" And .Cells(6) <> "wartend" Then
Ausgabe.Cells(OutRow, 5).Value = .Cells(2).Value
Ausgabe.Cells(OutRow, 6).Value = .Cells(5).Value
Ausgabe.Cells(OutRow, 7).Value = .Cells(6).Value
End If
End With
End If
Next CheckRow
Application.ScreenUpdating = True
End Sub

[snb]

oder:


Sub M_snb()
sn = Sheets("inventar").Cells(1).CurrentRegion
sp = Sheets("prüfliste").Cells(1).CurrentRegion
Set d_01 = CreateObject("scripting.dictionary")

With CreateObject("scripting.dictionary")
For j = 2 To UBound(sn)
x0 = .Item(sn(j, 4))
Next

For j = 2 To UBound(sp)
If .exists(sp(j, 2)) Then d_01.Item(sp(j, 1)) = Array(sp(j, 1), Format(Now, "DD.MM.YYYY HH:MM"), "bydo@vba.ms", "bydo")
Next
End With

If d_01.Count > 0 Then Sheets("ausgabe").Cells(2, 1).Resize(d_01.Count, 4) = Application.Index(d_01.items, 0, 0)
End Sub

[bydo]

Outstanding work xld,
The final result clocked in at 2 minutes 30 seconds, thanks a lot for your help!!
Mind if you tell me why your method is so much faster? What did you actually do?

Thanks a lot for your input also SamT,
your code took 8 minutes to work the lists!

[snb]

Crossposted in ca. 20 Fora:

http://www.clever-excel-forum.de/Thread-VBA-For-Schleife-Performanceprobleme?pid=80109#pid80109

[Zack Barresse]

bydo, please read this.

http://www.excelguru.ca/content.php?184

There are ways to cross-post, and there are ways to not. Please do not waste our members time.

[Bob Phillips]

Outstanding work xld,
The final result clocked in at 2 minutes 30 seconds, thanks a lot for your help!!
Mind if you tell me why your method is so much faster? What did you actually do?


My approach was to remove all of the loops, which is what takes all of the time. Instead, I setup each column with formulae that emulated your VBA logic. I then did a copy-pastevalues of them all. I did insert a column that you didn't want to get the row n umber which I used within those formulae, so I had to delete that at the end.