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