How to reduce runtime for code using ranges and string comparisons

Question

I have the following code and it does exactly what I need it to do however, the loop takes far too long to run (3 minutes +). I am new to VBA so I am not exactly sure 1) wha

Answer 1

Suggestion 1

Replace:

If Sheets("Sheet1").Range(Cells(i, 3), Cells(i, 3)) = "Police" 
    And Sheets("Sheet1").Range(Cells(i, 14), Cells(i, 14)) = "Bi-wkly Uniform Pay" Then _
  Sheets("Sheet1").Range(Cells(i, 3), Cells(i, 3)) = "Police - Uniform"

by:

With Sheets("Sheet1")
  If .Range(Cells(i, 3), Cells(i, 3)) = "Police" _
      And .Range(Cells(i, 14), Cells(i, 14)) = "Bi-wkly Uniform Pay" Then _
    .Range(Cells(i, 3), Cells(i, 3)) = "Police - Uniform"
End With

Suggestion 2

Replace:

.Range(Cells(i, 3), Cells(i, 3))

by

.Cells(i, 3)

Suggestion 3

Add:

Application.ScreenUpdating = False

Without this statement, the screen is repainted for every change. That chews up more time than anything else.

Answer 2

This may not be the best answer, but try setting local variable

Var sht1 = Sheets("Sheet1") might reduce ever so slightly the selecting of the sheet object. Also, there's no need to select the range and the cells using (i, 3) since it's a range of a single cell, so combined you'd have something like

 If sht1.Range.Cells(i,3) = "Police" And sht1.Range.Cells(i,14) = "Bi-wkly Uniform Pay" Then sh1.Range.Cells(i,3) = "Police Uniform" 
Next i

If that doesn't work and you can put it in a different column (say column O or 15), then you simply use a formula and then drag/double-click, or you could use an array formula over the entire column similarly and then press ctrl + shift + enter to make it compute as an array formula.

Hope this helps even a bit.

Answer 3

Accessing a sheet within a loop is very slow. A better approach is to copy the data into a Variant, array loop over the array and then copy the results back to the sheet

Something like this:

Sub Demo()
    Dim i As Long
    Dim datCol3 As Variant
    Dim datCol14 As Variant

    With Sheets("Sheet1")
        ' Copy data into a Variant Array
        datCol3 = .Range(.Cells(1, 3), .Cells(13000, 3)).Formula
        datCol14 = .Range(.Cells(1, 14), .Cells(13000, 14)).Value
        ' Loop over the array
        For i = 2 To 13000
            If datCol3(i, 1) = "Police" And datCol14(i, 1) = "Bi-wkly Uniform Pay" Then
                datCol3(i, 1) = "Police - Uniform"
            End If
        Next
        'Return the results to the sheet
        .Range(.Cells(1, 3), .Cells(13000, 3)).Formula = datCol3
    End With
End Sub