(Solved) – Ideas to make VBA looping faster?

  • by
(solved)-–-ideas-to-make-vba-looping-faster?

I have an issue with my code below (i only copied the relevant part). The code works fine, but it’s too slow. Basically the code compares data from Examplesheet2 with the data in Examplesheet3 and then moves it to 4 different worksheets. The code includes a search function and multiple nested if’s. There is no way around the fact that there are a lot of “if” conditions.

Does anyone have an idea how to improve the code in order to make it faster?

Sub WorksFine()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManual

Dim lr1 As Long
Dim lr2 As Long
Dim x As Long, n As Integer, m As Integer, o As Integer
Dim Arr As Variant
Dim rng As Range, rng2 As Range, cl As Range, cl2 As Range



n = 20 'Start row 
m = 20 'Start row 
o = 20 'Start row 
p = 21 'Start row 

Select Case ThisWorkbook.Worksheets("Examplesheet1").Range("AI2").Value

    Case Is = "Example"


        'Define range from which to match from
        With Blad6
            lr1 = Worksheets("ExampleSheet2").Cells(.Rows.Count, 1).End(xlUp).Row
            Arr = Worksheets("ExampleSheet2").Range("A2:A" & lr1   1)

        End With


        'Define range from which to look from
        With Sheet2
            lr2 = Worksheets("Examplesheet3").Cells(.Rows.Count, 2).End(xlUp).Row
            Set rng = Worksheets("Examplesheet3").Range("H2:H" & lr2)
        End With

        With Blad6
        For x = 1 To UBound(Arr)
        Set cl = rng.Find(Arr(x, 1), LookIn:=xlValues)

            If Not cl Is Nothing Then
                If Worksheets("Examplesheet1").Cells(x   1, 7) = cl.Offset(0, -4) And cl.Offset(0, -5) > Worksheets("Examplesheet1").Cells(x   1, 3) Then
FoundFullMatch:
                    Worksheets("Outputsheet1").Cells(n, 2).Value = Worksheets("Examplesheet1").Cells(x   1, 1)
                    Worksheets("Outputsheet1").Cells(n, 3).Value = Worksheets("Examplesheet1").Cells(x   1, 2)
                    Worksheets("Outputsheet1").Cells(n, 4).Value = Worksheets("Examplesheet1").Cells(x   1, 8)
                    Worksheets("Outputsheet1").Cells(n, 5).Value = Worksheets("Examplesheet1").Cells(x   1, 3)
                    Worksheets("Outputsheet1").Cells(n, 6).Value = Worksheets("Examplesheet1").Cells(x   1, 4)
                    Worksheets("Outputsheet1").Cells(n, 7) = cl.Offset(0, -5)
                    Worksheets("Outputsheet1").Cells(n, 8).Value = Worksheets("Examplesheet1").Cells(x   1, 6)
                    Worksheets("Outputsheet1").Cells(n, 9).Value = Worksheets("Examplesheet1").Cells(x   1, 5)
                    Worksheets("Outputsheet1").Cells(n, 10).Value = Worksheets("Examplesheet1").Cells(x   1, 7)
                    Worksheets("Outputsheet1").Cells(n, 11) = cl.Offset(0, -4)
                    Worksheets("Outputsheet1").Cells(n, 12).Value = Worksheets("Outputsheet1").Cells(n, 10).Value - Worksheets("Outputsheet1").Cells(n, 11).Value
                    If Worksheets("Outputsheet1").Cells(n, 6) = "" Then
                        GoTo ErrorHandler
                        ElseIf DateValue(Worksheets("Outputsheet1").Cells(n, 6)) < DateValue(Worksheets("Outputsheet1").Cells(n, 7)) Then
                        Worksheets("Outputsheet1").Cells(n, 13).Value = Worksheets("Outputsheet1").Cells(n, 7) - Worksheets("Outputsheet1").Cells(n, 6)
                        Else
ErrorHandler:
                    End If
                    Worksheets("Outputsheet2").Cells(p, 3).Value = cl.Offset(0, -5)
                    Worksheets("Outputsheet2").Cells(p, 4).Value = cl.Offset(0, -4) 
                    Worksheets("Outputsheet2").Cells(p, 5).Value = cl.Offset(0, 0) 
                    Worksheets("Outputsheet2").Cells(p, 6).Value = cl.Offset(0, 3) 
                    Worksheets("Outputsheet2").Cells(p, 7).Value = "Text" 
                    p = p   1
                    n = n   1

                Else



                    If cl.Row < lr2 Then
                    clmem = 1
KeepLooking:
                    With Sheet2
                        lr2 = Worksheets("Examplesheet2").Cells(.Rows.Count, 2).End(xlUp).Row
                        Set rng2 = Worksheets("Examplesheet2").Range("H" & cl.Row & ":H" & lr2)
                    End With
                    Set cl = rng2.Find(Arr(x, 1), LookIn:=xlValues)
                    If Not cl Is Nothing Then
                        If Worksheets("Examplesheet1").Cells(x   1, 7) = cl.Offset(0, -4) And cl.Offset(0, -5) > Worksheets("Examplesheet1").Cells(x   1, 3) Then
                        GoTo FoundFullMatch
                        Else
                            If cl.Row < lr2 And cl.Row <> clmem Then
                            clmem = cl.Row
                            GoTo KeepLooking

                    Else

                        If Not cl Is Nothing Then

                            If Worksheets("Examplesheet1").Cells(x   1, 7) <> cl.Offset(0, -4) And cl.Offset(0, -4) <> 0 And cl.Offset(0, -5) > Worksheets("Examplesheet1").Cells(x   1, 3) Then
                                Worksheets("Outputsheet3").Cells(m, 2).Value = Worksheets("Examplesheet1").Cells(x   1, 1)
                                Worksheets("Outputsheet3").Cells(m, 3).Value = Worksheets("Examplesheet1").Cells(x   1, 2)
                                Worksheets("Outputsheet3").Cells(m, 4).Value = Worksheets("Examplesheet1").Cells(x   1, 8)
                                Worksheets("Outputsheet3").Cells(m, 5).Value = Worksheets("Examplesheet1").Cells(x   1, 3)
                                Worksheets("Outputsheet3").Cells(m, 6).Value = Worksheets("Examplesheet1").Cells(x   1, 4)
                                Worksheets("Outputsheet3").Cells(m, 7) = cl.Offset(0, -5)
                                Worksheets("Outputsheet3").Cells(m, 8).Value = Worksheets("Examplesheet1").Cells(x   1, 6)
                                Worksheets("Outputsheet3").Cells(m, 9).Value = Worksheets("Examplesheet1").Cells(x   1, 5)
                                Worksheets("Outputsheet3").Cells(m, 10).Value = Worksheets("Examplesheet1").Cells(x   1, 7)
                                Worksheets("Outputsheet3").Cells(m, 11) = cl.Offset(0, -4)
                                Worksheets("Outputsheet3").Cells(m, 12).Value = Worksheets("Outputsheet3").Cells(m, 10).Value - Worksheets("Outputsheet3").Cells(m, 11).Value
                                Worksheets("Outputsheet3").Cells(m, 14) = cl.Offset(0, -2)
                                Worksheets("Outputsheet3").Cells(m, 15) = cl
                                Worksheets("Outputsheet2").Cells(p, 3).Value = cl.Offset(0, -5) 
                                Worksheets("Outputsheet2").Cells(p, 4).Value = cl.Offset(0, -4) 
                                Worksheets("Outputsheet2").Cells(p, 5).Value = cl.Offset(0, 0) 
                                Worksheets("Outputsheet2").Cells(p, 6).Value = cl.Offset(0, 3) 
                                Worksheets("Outputsheet2").Cells(p, 7).Value = "Text" 
                                p = p   1
                                m = m   1

                                Else


                                Worksheets("Outputsheet4").Cells(o, 2).Value = Worksheets("Examplesheet1").Cells(x   1, 1)
                                Worksheets("Outputsheet4").Cells(o, 3).Value = Worksheets("Examplesheet1").Cells(x   1, 2)
                                Worksheets("Outputsheet4").Cells(o, 4).Value = Worksheets("Examplesheet1").Cells(x   1, 8)
                                Worksheets("Outputsheet4").Cells(o, 5).Value = Worksheets("Examplesheet1").Cells(x   1, 3)
                                Worksheets("Outputsheet4").Cells(o, 6).Value = Worksheets("Examplesheet1").Cells(x   1, 4)
                                Worksheets("Outputsheet4").Cells(o, 8).Value = Worksheets("Examplesheet1").Cells(x   1, 6)
                                Worksheets("Outputsheet4").Cells(o, 9).Value = Worksheets("Examplesheet1").Cells(x   1, 5)
                                Worksheets("Outputsheet4").Cells(o, 10).Value = Worksheets("Examplesheet1").Cells(x   1, 7)

                                o = o   1

                                End If


                        Else

                         Worksheets("Outputsheet4").Cells(o, 2).Value = Worksheets("Examplesheet1").Cells(x   1, 1)
                                Worksheets("Outputsheet4").Cells(o, 3).Value = Worksheets("Examplesheet1").Cells(x   1, 2)
                                Worksheets("Outputsheet4").Cells(o, 4).Value = Worksheets("Examplesheet1").Cells(x   1, 8)
                                Worksheets("Outputsheet4").Cells(o, 5).Value = Worksheets("Examplesheet1").Cells(x   1, 3)
                                Worksheets("Outputsheet4").Cells(o, 6).Value = Worksheets("Examplesheet1").Cells(x   1, 4)
                                Worksheets("Outputsheet4").Cells(o, 8).Value = Worksheets("Examplesheet1").Cells(x   1, 6)
                                Worksheets("Outputsheet4").Cells(o, 9).Value = Worksheets("Examplesheet1").Cells(x   1, 5)
                                Worksheets("Outputsheet4").Cells(o, 10).Value = Worksheets("Examplesheet1").Cells(x   1, 7)

                                o = o   1

                        End If
                        End If
                        End If
                        End If
                        End If
                        End If

                    Else

                     Worksheets("Outputsheet4").Cells(o, 2).Value = Worksheets("Examplesheet1").Cells(x   1, 1)
                                Worksheets("Outputsheet4").Cells(o, 3).Value = Worksheets("Examplesheet1").Cells(x   1, 2)
                                Worksheets("Outputsheet4").Cells(o, 4).Value = Worksheets("Examplesheet1").Cells(x   1, 8)
                                Worksheets("Outputsheet4").Cells(o, 5).Value = Worksheets("Examplesheet1").Cells(x   1, 3)
                                Worksheets("Outputsheet4").Cells(o, 6).Value = Worksheets("Examplesheet1").Cells(x   1, 4)
                                Worksheets("Outputsheet4").Cells(o, 8).Value = Worksheets("Examplesheet1").Cells(x   1, 6)
                                Worksheets("Outputsheet4").Cells(o, 9).Value = Worksheets("Examplesheet1").Cells(x   1, 5)
                                Worksheets("Outputsheet4").Cells(o, 10).Value = Worksheets("Examplesheet1").Cells(x   1, 7)

                    o = o   1

                    End If

        Next

    End With

Leave a Reply

Your email address will not be published. Required fields are marked *