Slow running macro

[Phil Payne]

I have worksheet macro that takes a very long time to run. There are only 47 target cells and it takes up to 30 seconds to complete!
Can anyone see how I can improve on this?

Private Sub Worksheet_Change(ByVal Target As Range)
' This code checks for a change of Status in the Current Status column and
' on change sets (adjacent) cells' 'interior' and 'font ' colours according to table "rCodes".
    If Target.Count > 1 Then Exit Sub
    Dim rCell As Range
    Dim rCodes As Range
    Dim rRow As Range
    Dim vMatch
    Dim LastRow As Long
    LastRow = Range("A65536").End(xlUp).Row
    Set rCodes = Range("g6:g16")
    If (Target.Column >= 1) And (Target.Column <= Range("D1").Column) And (Target.Row <= LastRow) Then
        If Len(Target.Value) > 0 Then
            On Error Resume Next
            vMatch = Application.Match(Target.Value, rCodes, 0)
            If IsError(vMatch) Then
               'DO NOTHING
            Else
                With Target.Cells
                     .Offset(0, -1).Interior.Color = rCodes.Cells(vMatch).Interior.Color
                     .Offset(0, -1).Font.Color = rCodes.Cells(vMatch).Font.Color
                End With
            End If
        End If
    End If
End Sub

Thanks in anticipation.
Phil

 

[Phil Payne]

Hello Rick,

It's resolved.

It turns out that I needed to include and properly position Application.ScreenUpdating = False/True and Application.Calculation = xlCalculationManual/xlCalculationAutomatic

Thanks very much indeed for your help.

All the best.

Phil