Private Sub Worksheet_SelectionChange(ByVal Target As Range) Set s = Application.Intersect(Target, Range(C5:E17)) If Target.Count = 1 And Not (s Is Nothing) Then If Application.WorksheetFunction.CountIf(Range(L:L), Target) 0 Then r = Range(L:L).Find(Target).Row Cells(r, N) = Cells(r, N) + 1 Else r1 = [l65536].End(xlUp).Row + 1 Cells(r1, L) = Target Cells(r1, N) = 1 End If End IfEnd Sub