Identify No Relations

[LPrada]

Hi,
I was using a Macro (MG22Feb27) who identify no Relations from Column A (Client) vs Column B (Counterpart).
The results were generated on column D (Client) and E (Counterpart). I am attaching the current file I am using with a test Data.

The file was working well until I grow into 1,907 records to compare Column A vs Column B. Now I am getting and error, because the result I guess overpass the limit of rows 1,048,576 on the sheet.
My question is, there is a way to setup the same macro at Access or SQL to get the full results.
Or It is possible to change the macro to break the results to continue in another Column from the top.
I really appreciate your help in this subject. I'm not very wise on VBA, however all the help is appraised.
Thanks so much.
Leo

 

[AliGW]

Cross-posted: https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/1220778-identify-no-relations

 

[vletm]

LPrada
Please, You should reread Forum rules:

Site Rules - New Users - Please Read

Hi all, Welcome to the Chandoo.org Forums. Posting Rules & Etiquette The Chandoo.org Forums is a collaborative and happy place to learn and expand your Excel knowledge. The Chandoo.org Forums consist of several Sub-Forums based on the type of question/area of Excel you are interested in...

chandoo.org

 

[LPrada]

Thanks to KjBox, who helped me with the following solution.
This code continue evaluating the relations on the next Columns, before it overpass the limit of Rows, 1,048,576.
The unique change I made was on the total Loops on the first and Second For cycle.

Again KjBox, Thanks so much for your help, .

Dear AliGW,
Sorry for posted the same question in another Forum.

Leo

Sub MG22Feb27()
    Dim Dn As Range, Rng As Range, RngHD As Range
    Dim k, kk, Ray, Ray2, Dic As Object, Dic1 As Object
    Dim x, y, i As Long, ii As Long, c As Long, Fd As Boolean

    Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.comparemode = 1
    Set Dic1 = CreateObject("Scripting.Dictionary")
    Dic1.comparemode = 1

    For Each Dn In Rng
         If Not Dic1.exists(Dn.Offset(, 1).Value) Then Dic1.Add Dn.Offset(, 1).Value, Nothing
            If Not Dic.exists(Dn.Value) Then
                Set Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
            End If
        If Not Dic(Dn.Value).exists(Dn.Offset(, 1).Value) Then
                Dic(Dn.Value).Add (Dn.Offset(, 1).Value), Nothing
        End If
    Next Dn
   
    ReDim x(1 To Dic.Count): ReDim y(1 To Dic1.Count): c = 0
    For Each k In Dic.keys
        If k <> 0 And k <> 1 And k <> -1 Then c = c + 1: x(c) = k
    Next
    c = 0
    For Each k In Dic1.keys
        If k <> 0 And k <> 1 And k <> -1 Then c = c + 1: y(c) = k
    Next
   
    If UBound(x) * UBound(y) <= Rows.Count - 1 Then
        ReDim Ray(1 To (UBound(x) * UBound(y)) + 1, 1 To 2)
        Ray(1, 1) = "Client": Ray(1, 2) = "Counterpart": c = 1
        For i = 1 To UBound(x)
            Fd = True
            For ii = 1 To UBound(y)
                 If Not Dic.exists(Dic1(y(ii))) Then
                     c = c + 1
                     Ray(c, 1) = IIf(Fd, x(i), x(i))
                     Ray(c, 2) = y(ii)
                     Fd = False
                 End If
             Next ii
        Next i
        With [d1]
            .Offset(1).Resize(Rows.Count - 1, 2).Clear
            .Resize(UBound(Ray, 1), 2) = Ray
            With .CurrentRegion
                .Columns.AutoFit
                .Borders.Weight = 2
            End With
        End With
    Else
        ReDim Ray1(1 To Rows.Count, 1 To 2)
        Ray1(1, 1) = "Client": Ray1(1, 2) = "Counterpart": c = 1
        For i = 1 To 1020
            Fd = True
            For ii = 1 To 1020
                If Not Dic.exists(Dic1(y(ii))) Then
                    c = c + 1
                    Ray1(c, 1) = IIf(Fd, x(i), x(i))
                    Ray1(c, 2) = y(ii)
                    Fd = False
                End If
             Next ii
        Next i
        ReDim Ray2(1 To (UBound(x) * UBound(y)) - Rows.Count, 1 To 2)
        Ray2(1, 1) = "Client": Ray2(1, 2) = "Counterpart": c = 1
        For i = 1022 To UBound(x, 1)
            Fd = True
            For ii = 1022 To UBound(y, 1)
                If Not Dic.exists(Dic1(y(ii))) Then
                    c = c + 1
                    Ray2(c, 1) = IIf(Fd, x(i), x(i))
                    Ray2(c, 2) = y(ii)
                    Fd = False
                End If
             Next ii
        Next i
        With [d1]
            .Offset(1).Resize(Rows.Count - 1, 2).Clear
            .Resize(UBound(Ray1, 1), 2) = Ray1
            With .CurrentRegion
                .Columns.AutoFit
                .Borders.Weight = 2
            End With
        End With
        With [g1]
            .Offset(1).Resize(Rows.Count - 1, 2).Clear
            .Resize(UBound(Ray2, 1), 2) = Ray2
            With .CurrentRegion
                .Columns.AutoFit
                .Borders.Weight = 2
            End With
        End With
    End If
   
End Sub