Speed up vba loop

Question

Every week in work I have a file of around 15000 customers that I need to break up into two categories based on their names. My current code works but it loops through every row taking almost 3 minutes to run. What would be the best way to improve the speed - I'm assuming there are much more efficient methods than the lengthy if statement I've used?

Option Compare Text

Private Sub CommandButton1_Click()

Dim i As Long

Application.ScreenUpdating = False

For i = 2 To Rows.Count

    If Cells(i, 33).Value = "Business" Then
        Cells(i, 32).Value = "B"
    ElseIf Cells(i, 33).Value = "Personal" Then
        Cells(i, 32).Value = "P"
    ElseIf Cells(i, 12).Value = "N" Then
        Cells(i, 32).Value = "B"
    ElseIf Cells(i, 12).Value = "Y" Then
        Cells(i, 32).Value = "P"
    ElseIf Cells(i, 20).Value = "PREMIER" Then
        Cells(i, 32).Value = "P"
    ElseIf InStr(1, Cells(i, 4), "LTD") <> 0 Then 'Finds each word in customer name, column D, and enters it as business customer
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "LIMITED") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "MANAGE") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "BUSINESS") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "CONSULT") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "INTERNATIONAL") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "T/A") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "TECH") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "CLUB") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "OIL") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "SERVICE") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "SOLICITOR") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf Cells(i, 4).Value = "UIT" Then
        Cells(i, 32).Value = "B"
    Else
        Cells(i, 32).Value = ""
    End If
Next i
Application.ScreenUpdating = True

End Sub

Start off by not looping to `Rows.Count`, but by finding the last row, inspiration [here](https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-vba). You're needlessly looping through hundreds of thousands of rows. — BigBen, Dec 14 '18 at 10:12
Have you done any research yourself on speeding up code? I imagine Google would return a few results. — SJR, Dec 14 '18 at 10:26
No need to use a loop. Use `.Find` and `.FindNext`. This will be much faster. [Here](http://www.siddharthrout.com/index.php/2018/01/11/find-and-findnext-in-excel-vba/) is an example — Siddharth Rout, Dec 14 '18 at 10:31
Is there a reason that prevents you from only sorting the "new" data, ie that which has arrived in the last week? Or only those records / customers that have been updated in the past week... This would make it much faster... — Solar Mike, Dec 14 '18 at 11:13
Try capturing the data into an array and then transposing the result into the sheet. Much faster to work with memory then on an excel file.. specially if you are working with large data set — Zac, Dec 14 '18 at 11:18
@BigBen thanks! Should've spotted that takes a couple of seconds now — edev, Dec 19 '18 at 13:46

score 2 · Accepted Answer · answered Dec 14 '18 at 14:26

If you want to speed up the process, I'd stop using VBA, but write a formula instead.

Example: for finding if a cell equals "Business" or "N", you can use something like this:

=IF(OR(A1="Business";A2="N");"B";"P")

For finding if a cell contains "Business", you can use something like this:

=IF(FIND("Business";A1);"B";"P")

Combining all of this using the OR() worksheet function, you can get the whole thing. Obviously you'll need to drag your formula over your the entire column within your worksheet.

score 1 · Answer 2 · answered Dec 14 '18 at 13:50

Try

Private Sub CommandButton1_Click()

    Dim i As Long, r As Long
    Dim vDB As Variant
    Dim Ws As Worksheet
    Dim rngDB As Range

    Set Ws = ActiveSheet
    Set rngDB = Ws.UsedRange
    vDB = rngDB
    r = UBound(vDB, 1)



    For i = 2 To r

        If vDB(i, 33) = "Business" Then
            vDB(i, 32) = "B"
        ElseIf vDB(i, 33) = "Personal" Then
            vDB(i, 32) = "P"
        ElseIf vDB(i, 12) = "N" Then
            vDB(i, 32) = "B"
        ElseIf vDB(i, 12) = "Y" Then
            vDB(i, 32) = "P"
        ElseIf vDB(i, 20) = "PREMIER" Then
            vDB(i, 32) = "P"
        ElseIf InStr(1, vDB(i, 4), "LTD") <> 0 Then 'Finds each word in customer name, column D, and enters it as business customer
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "LIMITED") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "MANAGE") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "BUSINESS") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "CONSULT") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "INTERNATIONAL") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "T/A") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "TECH") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "CLUB") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "OIL") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "SERVICE") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "SOLICITOR") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf vDB(i, 4) = "UIT" Then
            vDB(i, 32) = "B"
        Else
            vDB(i, 32) = ""
        End If
    Next i
    rngDB = vDB
End Sub

Speed up vba loop

2 Answers2