Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long
If WorksheetFunction.CountA(Target) = 0 Then Selection.Font.ColorIndex = xlAutomatic Selection.Interior.Pattern = xlNone End If If Target.Column() <> 1 Then Exit Sub
Application.EnableEvents = False On Error GoTo Err
For i = 1 To Target.Row() If Cells(i, 1).Value = Target.Value Then Cells(i, 2).Value = Cells(i, 2).Value + 1 Exit For End If Next i If i = Target.Row() Then Target.Offset(1, 0).Select Else Target.Select Target.Clear End If
Err: Application.EnableEvents = True On Error GoTo 0 End Sub