CODEWITHSUNDEEP
vbaexcel
alex2002
alex2002

Reputation: 161

Loop and IF statement takes too much time

The code bellow is suppose to do a vlookup in a different worksheet based on some criteria. I declared all the variables and it does its job, but it takes too much time to wait. I believe that this is because of the loop and the two if statements I have, but I cannot see another way of writing two criteria (IF statements). Any other approach will be must appreciated. Thanks!

Please find attached the code below:

Private Sub CommandButton3_Click()

    Dim vlookup As Variant
    Dim lastRow As Long, lastRow1 As Long
    Dim ws As Worksheet, ws1 As Worksheet
    Dim j As Long



    Set ws = Sheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set ws1 = Sheets("Sheet2")
    lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row



    Application.ScreenUpdating = False


   For j = 2 To lastRow

    If Cells(j, "a") > 1000 And Cells(j, "b") <> "" Then

    With ws.Range("f2:f" & lastRow)
        .Formula = "=iferror(vlookup(e2, " & ws1.Range("a2:c" & lastRow1).Address(1, 1, external:=True) & ", 3, false), text(,))"
        .value = .value
    End With

    ElseIf Cells(j, "a") > 1000 Then

    With ws.Range("f2:f" & lastRow)
        .Formula = "=iferror(vlookup(d2, " & ws1.Range("a2:c" & lastRow1).Address(1, 1, external:=True) & ", 3, false), text(,))"
        .value = .value
    End With

    Else

    Cells(j, "f") = "No"


    End If

    Next

End Sub

Upvotes: 0

Views: 58

Answers (1)

user4039065
user4039065

Reputation:

You are writing and rewriting the same formula(s) into the same cells over and over.

Private Sub CommandButton3_Click()

    Dim r As Variant
    Dim lastRow As Long, lastRow1 As Long, j As Long
    Dim ws As Worksheet, ws1 As Worksheet, rng As Range

    Set ws = Worksheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set ws1 = Worksheets("Sheet2")
    lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    Set rng = ws1.Columns(1)

    With ws
        For j = 2 To lastRow
            If .Cells(j, "a") > 1000 And .Cells(j, "b") <> "" Then
                r = Application.Match(.Cells(j, "e").Value2, rng, 0)
                If Not IsError(r) Then
                    .Cells(j, "f") = ws1.Cells(r, "c").Value
                else
                    .Cells(j, "f") = vbnullstring
                End If
            ElseIf .Cells(j, "a") > 1000 Then
                r = Application.Match(.Cells(j, "d").Value2, rng, 0)
                If Not IsError(r) Then
                    .Cells(j, "f") = ws1.Cells(r, "c").Value
                else
                    .Cells(j, "f") = vbnullstring
                End If
            Else
                .Cells(j, "f") = "No"
            End If
        Next j
    End With

End Sub

Upvotes: 1

Related Questions