Make code more efficient

[Barryj]

I have the below code which works fine but is a bit slow, just wondering if it could be made more efficient to speed up the process.


Sub Offset()Application.ScreenUpdating = False
Dim r As Range
Dim a As Range
Set r = ActiveSheet.Range("C5:C1372")
For Each a In r
If a.Value = "WIC" Then
a.Offset(, -1) = a.Value
a.Value = ""

End If

If a.Value = "WTC" Then
a.Offset(, -1) = a.Value
a.Value = ""

End If

If a.Value = "AL" Then
a.Offset(, -1) = a.Value
a.Value = ""

End If

If a.Value = "CDW" Then
a.Offset(, -1) = a.Value
a.Value = ""

End If


If a.Value = "INJ" Then
a.Offset(, -1) = a.Value
a.Value = ""

End If

If a.Value = "Sick" Then
a.Offset(, -1) = a.Value
a.Value = ""

End If

If a.Value = "CL" Then
a.Offset(, -1) = a.Value
a.Value = ""

End If


If a.Value = "TW" Then
a.Offset(, -1) = a.Value
a.Value = ""

End If
If a.Value = "JC" Then
a.Offset(, -1) = a.Value
a.Value = ""

End If

If a.Value = "LSL" Then
a.Offset(, -1) = a.Value
a.Value = ""

End If
If a.Value = "WO" Then
a.Offset(, -1) = a.Value
a.Value = ""

End If
If a.Value = "2PJ" Then
a.Offset(, -1) = a.Value
a.Value = ""

End If

If a.Value = "AJQ" Then
a.Offset(, -1) = a.Value
a.Value = ""

End If

If a.Value = "HFG" Then
a.Offset(, -1) = a.Value
a.Value = ""

End If



Next

LR = Cells(Rows.Count, 17).End(xlUp).Row




Application.ScreenUpdating = True






End Sub

Thanks for any assistance.

[snb]

Use arrays and Select Case.

[SamT]

Using an explicitm yet dynamic, range will be faster
Using a Select Case or an If...Then...ElseIf will cut the time in about half
Using an If InStr will be even faster
Using Arrays will be fastest yet.


Dim CheckStr As String
Dim r As Range
Dim a As Range

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

CheckStr = "HFG, AJQ, 2PJ, etc"
Set r = ActiveSheet.Range(Range("C5"), Cells(Rows.Count, "C").End(xlUp))")

For Each a In r
If Cbool(Instr(CheckStr, a) Then
a.Offset(, -1) = a.Value
a.Value = ""
End If
Next
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

End Sub

[snb]

Array approach


Sub M_snb()
sn = columns(5).specialcells(2).offset(4).specialcells(2).offset(,-1).resize(,2)

for j=1 to ubound(sn)
if instr(" HFG AJQ 2PJ ", " " & sn(j,2) & " ") then
sn(j,1)=sn(j,2)
sn(j,2)=""
end if
next

columns(5),specialcells(2).offset(4).specialcells(2).offset(,-1).resize(,2)=sn
end sub

[Paul_Hossler]

All those If/Then's still get tested even if you find "WIC", etc.

For something like this which runs in microseconds, I'd opt for making the code 'man readable' as much as possible

27119



Option Explicit


Sub Offset()
Application.ScreenUpdating = False
Dim r As Range
Dim a As Range

Set r = ActiveSheet.Range("C5:C1372")

For Each a In r
With a
Select Case .Value
Case "WIC", "WTC", "AL", "CDW", "INJ", "Sick", "CL", "TW", "JC", "LSL", "WO", "2PJ", "AJQ", "HFG"
.Offset(, -1) = .Value
.Clear
End Select
End With
Next

Application.ScreenUpdating = True


End Sub

[Barryj]

Thank you for your replies Snb, SamT & Paul_Hossler, I have tested the 3 codes and they work fine and as I was aiming for and have provided a noticeable speed increase. thank you very much for your assistance and I will mark this thread as solved.