Help to make code run faster

[excel_beginer]

Hi all again
I have code belove to copy row(i) to another sheet if met conditions, it run okey with data under 50 rows but when data over 500 rows code run very slow.

Could you have some suggestions or can make this code run more faster
thanks in advanced

Sub Check_G02782()Worksheets("check_G02782").Range("A2:K5000").Clear
Application.ScreenUpdating = False
Dim i As Long, lastrow As Long, lastrowG02782 As Long
    lastrowG02782 = Sheets("G02782").Range("A" & Rows.Count).End(xlUp).Row + 1
    For i = 2 To lastrowG02782
        lastrow = Sheets("check_G02782").Cells(Rows.Count, 2).End(xlUp).Row
        With Sheets("G02782")
             If .Cells(i, 5).Value <> 0 And .Cells(i, 7).Value <> 0 Then
                .Cells(i, 10).Value = (.Cells(i, 4).Value / .Cells(i, 5).Value)
                .Cells(i, 11).Value = (.Cells(i, 6).Value / .Cells(i, 7).Value)
            End If
            If .Cells(i, 10).Value > 1 And .Cells(i, 11).Value = 0 Then
            ElseIf .Cells(i, 11).Value > 1 And .Cells(i, 10).Value = 0 Then
            ElseIf .Cells(i, 10).Value < 1 Then
                .Rows(i).Copy (Sheets("check_G02782").Range("A" & lastrow + 1))
            ElseIf .Cells(i, 11).Value < 1 Then
                .Rows(i).Copy (Sheets("check_G02782").Range("A" & lastrow + 1))
            End If
        End With
    Next i
Application.ScreenUpdating = True
End Sub

 

[igold]

Hi,

Do you have a row of real data you could share. This code will run on over 50k rows of my data in about 1.5 seconds. However I had to use generic data which was: Column A was all 1's, Column B was all 2's, Column C was all 3's etc, al the way up to Column K which was 11's.

I indicated in Red where I could not use your If statements because I don't know what your data looks like. I do think if you run this code on your sheet (a backup copy) it will run, but it may not produce the correct results. What slows your code up is that the code is going to the worksheet to write data for every row. You need to perform these calculations in memory and write all the rows at once.

Sub Check_G02782()


    Dim i As Long, lastrow As Long, lastrowG02782 As Long
    Dim GO2


    Application.ScreenUpdating = False
    Worksheets("check_G02782").Range("A2:K5000").Clear
    lastrowG02782 = Sheets("G02782").Range("A" & Rows.Count).End(xlUp).Row + 1
    GO2 = Range("A2:K" & lastrowG02782)
    For i = LBound(GO2) To UBound(GO2)
        lastrow = Sheets("check_G02782").Cells(Rows.Count, 2).End(xlUp).Row
            If GO2(i, 5) <> 0 And GO2(i, 7) <> 0 Then
                GO2(i, 10) = GO2(i, 4) / GO2(i, 5)
                GO2(i, 11) = GO2(i, 6) / GO2(i, 7)
            End If
            If GO2(i, 10) > 1 And GO2(i, 11) = 0 Then
                If GO2(i, 11) > 1 And GO2(i, 10) = 0 Then
                    If GO2(i, 10) < 1 Then
[COLOR=#ff0000]                    ' I NEED TO SEE REAL DATA[/COLOR]
                            If GO2(i, 11) < 1 Then
[COLOR=#ff0000]                    ' I NEED TO SEE REAL DATA[/COLOR]
                            End If
                    End If
                End If
            End If
    Next
    Sheets("G02782").Range("A2").Resize(UBound(GO2, 1), UBound(GO2, 2)) = GO2
    Sheets("check_G02782").Range("A2").Resize(UBound(GO2, 1), UBound(GO2, 2)) = GO2
    Application.ScreenUpdating = True


End Sub

I hope this helps.