Сравнить строки в 2 столбцах каждую с каждой

Sub renumb()
Dim r&, rr&
For r = 2 To ActiveSheet.UsedRange.Rows.Count
  If Cells(r, 3) > 0 Then
    For rr = r + 1 To ActiveSheet.UsedRange.Rows.Count
      If Cells(r, 6) = Cells(rr, 6) Then
        If Cells(r, 7) = Cells(rr, 7) Then
          Cells(rr, 3) = Cells(r, 3)
        End If
      End If
    Next rr
  End If
Next r
End Sub

 If Cells(r, 6) = Cells(rr, 6) Then

Sub QWERT()
Dim M(), K, r, T, OD: Set OD = CreateObject("Scripting.Dictionary")
M = Range("A1").Resize(Cells(Rows.Count, 1).End(xlUp).Row, 12)
    For r = 3 To UBound(M)
        If M(r, 6) <> "" Then
            T = M(r, 6) & ";" & M(r, 7)
            If Not OD.exists(T) Then K = K + 1: OD(T) = K
            M(r, 3) = OD(T)
        End If
    Next r
Range("A1").Resize(Cells(Rows.Count, 1).End(xlUp).Row, 12) = M
MsgBox "Уникальных точек " & K & " из " & UBound(M), 64, ""
End Sub

Sub QWERT()
Dim M(), K, r, T, J, OD: Set OD = CreateObject("Scripting.Dictionary")
M = Range("A1").Resize(Cells(Rows.Count, 1).End(xlUp).Row, 12)
    For r = 3 To UBound(M)
        If M(r, 6) <> "" Then
        J = J + 1
            T = M(r, 6) & ";" & M(r, 7)
            If Not OD.exists(T) Then K = K + 1: OD(T) = K
            M(r, 3) = OD(T)
        End If
    Next r
Range("A1").Resize(Cells(Rows.Count, 1).End(xlUp).Row, 12) = M
MsgBox "Уникальных точек " & K & " из " & J, 64, ""
End Sub