Sub qqq()
Dim LastRow As Long, Arr(), i As Long, j As Long, Counter As Long
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Arr = Range(Cells(2, 1), Cells(LastRow, 2)).Value
    For i = 1 To UBound(Arr)
        For j = 1 To UBound(Arr)
            If Arr(j, 2) = Arr(i, 1) Then Counter = Counter + 1
        Next
    Next
    MsgBox Counter
End Sub

w = Split(ActiveWorkbook.Name, ".")(0)

w = ActiveWorkbook.Name

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("D2:D10")) Is Nothing Then
        If Target = "" Then
            Target = Time
        Else
            Application.EnableEvents = False
            Target.Offset(1, 0).Select
        End If
    End If
    Application.EnableEvents = True
End Sub