Match data columns to columns million + with scripting dictionary

SamKhem · Aug 21, 2024

Dear Senior member
I would like you to assist as I have 4 columns data 1 to 4 and 4 columns Main 1 to Main 4. Need to matching base on data 1 to data 4 compare with Main1 to Main 4 and get result 1 to result 4 and different 1 to different 4 as sample below.
Thank for support.



Data 1	Data 2	Data 3	Data 4	Main 1	Main 2	Main 3	Main 4	Match 1	Match 2	Match 3	Match 4	Different 1	Different 2	Different 3	Different 4
ABC-2222-123345	DEF-2222-123345	GHT-2222-123345	NBC-2222-123345	ABC-0987-89766	DEF-0987-89766	GHT-0987-89766	NBC-0987-89766
ABC-1111-123345	DEF-1111-123345	GHT-1111-123345	NBC-1111-123345	ABC-1111-123345	DEF-1111-123345	GHT-1111-123345	NBC-1111-123345
ABC-2222-89765	DEF-2222-89765	GHT-2222-89765	NBC-2222-89765	ABC-1285-89771	DEF-1285-89771	GHT-1285-89771	NBC-1285-89771
ABC-0987-89766	DEF-0987-89766	GHT-0987-89766	NBC-0987-89766	ABC-2222-123345	DEF-2222-123345	GHT-2222-123345	NBC-2222-123345
ABC-2222-89767	DEF-2222-89767	GHT-2222-89767	NBC-2222-89767	ABC-2222-89765	DEF-2222-89765	GHT-2222-89765	NBC-2222-89765
ABC-2222-89768	DEF-2222-89768	GHT-2222-89768	NBC-2222-89768	ABC-2222-89767	DEF-2222-89767	GHT-2222-89767	NBC-2222-89767
ABC-2222-89769	DEF-2222-89769	GHT-2222-89769	NBC-2222-89769	ABC-2222-89768	DEF-2222-89768	GHT-2222-89768	NBC-2222-89768
ABC-2222-89770	DEF-2222-89770	GHT-2222-89770	NBC-2222-89770	ABC-2222-89769	DEF-2222-89769	GHT-2222-89769	NBC-2222-89769
ABC-1285-89771	DEF-1285-89771	GHT-1285-89771	NBC-1285-89771	ABC-2222-89770	DEF-2222-89770	GHT-2222-89770	NBC-2222-89770
ABC-2222-89772	DEF-2222-89772	GHT-2222-89772	NBC-2222-89772	ABC-2222-89772	DEF-2222-89772	GHT-2222-89772	NBC-2222-89772
ABC-2222-89773	DEF-2222-89773	GHT-2222-89773	NBC-2222-89773	ABC-2222-89773	DEF-2222-89773	GHT-2222-89773	NBC-2222-89773
ABC-2222-89774	DEF-2222-89774	GHT-2222-89774	NBC-2222-89774	ABC-2222-89774	DEF-2222-89774	GHT-2222-89774	NBC-2222-89774
ABC-2222-89775	DEF-2222-89775	GHT-2222-89775	NBC-2222-89775	ABC-2222-89775	DEF-2222-89775	GHT-2222-89775	NBC-2222-89775
ABC-2222-89776	DEF-2222-89776	GHT-2222-89776	NBC-2222-89776	ABC-2222-89776	DEF-2222-89776	GHT-2222-89776	NBC-2222-89776
ABC-2222-89777	DEF-2222-89777	GHT-2222-89777	NBC-2222-89777	ABC-2222-89777	DEF-2222-89777	GHT-2222-89777	NBC-2222-89777
ABC-2222-89778	DEF-2222-89778	GHT-2222-89778	NBC-2222-89778	ABC-2222-89778	DEF-2222-89778	GHT-2222-89778	NBC-2222-89778
ABC-2222-89779	DEF-2222-89779	GHT-2222-89779	NBC-2222-89779	ABC-2222-89779	DEF-2222-89779	GHT-2222-89779	NBC-2222-89779
ABC-2222-89780	DEF-2222-89780	GHT-2222-89780	NBC-2222-89780	ABC-2222-89780	DEF-2222-89780	GHT-2222-89780	NBC-2222-89780
ABC-2222-89781	DEF-2222-89781	GHT-2222-89781	NBC-2222-89781	ABC-2222-89781	DEF-2222-89781	GHT-2222-89781	NBC-2222-89781
ABC-2222-89782	DEF-2222-89782	GHT-2222-89782	NBC-2222-89782	ABC-2222-89782	DEF-2222-89782	GHT-2222-89782	NBC-2222-89782
ABC-2223-89777	DEF-2223-89780	GHT-2223-89778	NBC-1222-89781	ABC-2222-89783	DEF-2222-89783	GHT-2222-89783	NBC-2222-89783
ABC-2223-89778	DEF-2223-89781	GHT-2223-89779	NBC-1222-89782	ABC-2222-89784	DEF-2222-89784	GHT-2222-89784	NBC-2222-89784
ABC-2223-89779		GHT-2223-89780		ABC-2222-89785	DEF-2222-89785	GHT-2222-89785	NBC-2222-89785
ABC-2223-89780				ABC-2222-89786	DEF-2222-89786	GHT-2222-89786	NBC-2222-89786
ABC-2223-89781				ABC-2222-89787	DEF-2222-89787	GHT-2222-89787	NBC-2222-89787
ABC-2223-89782				ABC-2222-89788	DEF-2222-89788	GHT-2222-89788	NBC-2222-89788
ABC-2223-89783				ABC-2222-89789	DEF-2222-89789	GHT-2222-89789	NBC-2222-89789
				ABC-2222-89790	DEF-2222-89790	GHT-2222-89790	NBC-2222-89790
				ABC-2222-89791	DEF-2222-89791	GHT-2222-89791	NBC-2222-89791
				ABC-2222-89792	DEF-2222-89792	GHT-2222-89792	NBC-2222-89792
				ABC-2222-89793	DEF-2222-89793	GHT-2222-89793	NBC-2222-89793
				ABC-2222-89794	DEF-2222-89794	GHT-2222-89794	NBC-2222-89794
				ABC-2222-89795	DEF-2222-89795	GHT-2222-89795	NBC-2222-89795
				ABC-2222-89796	DEF-2222-89796	GHT-2222-89796	NBC-2222-89796
				ABC-2222-89797	DEF-2222-89797	GHT-2222-89797	NBC-2222-89797
				ABC-2222-89798	DEF-2222-89798	GHT-2222-89798	NBC-2222-89798
				ABC-2222-89799	DEF-2222-89799	GHT-2222-89799	NBC-2222-89799
				ABC-2222-89800	DEF-2222-89800	GHT-2222-89800	NBC-2222-89800
				ABC-2222-89801	DEF-2222-89801	GHT-2222-89801	NBC-2222-89801
				ABC-2222-89802	DEF-2222-89802	GHT-2222-89802	NBC-2222-89802
				ABC-2222-89803	DEF-2222-89803	GHT-2222-89803	NBC-2222-89803
				ABC-2222-89804	DEF-2222-89804	GHT-2222-89804	NBC-2222-89804
				ABC-2222-89805	DEF-2222-89805	GHT-2222-89805	NBC-2222-89805
				ABC-2222-89806	DEF-2222-89806	GHT-2222-89806	NBC-2222-89806
				ABC-2222-89807	DEF-2222-89807	GHT-2222-89807	NBC-2222-89807
				ABC-2222-89808	DEF-2222-89808	GHT-2222-89808	NBC-2222-89808
				ABC-2222-89809	DEF-2222-89809	GHT-2222-89809	NBC-2222-89809
				ABC-2222-89810	DEF-2222-89810	GHT-2222-89810	NBC-2222-89810
				ABC-2222-89811	DEF-2222-89811	GHT-2222-89811	NBC-2222-89811
				ABC-2222-89812	DEF-2222-89812	GHT-2222-89812	NBC-2222-89812
				ABC-2222-89813	DEF-2222-89813	GHT-2222-89813	NBC-2222-89813
				ABC-2222-89814	DEF-2222-89814	GHT-2222-89814	NBC-2222-89814
				ABC-2222-89815	DEF-2222-89815	GHT-2222-89815	NBC-2222-89815
				ABC-2222-89816	DEF-2222-89816	GHT-2222-89816	NBC-2222-89816
				ABC-2222-89817	DEF-2222-89817	GHT-2222-89817	NBC-2222-89817
				ABC-2222-89818	DEF-2222-89818	GHT-2222-89818	NBC-2222-89818
				ABC-2222-89819	DEF-2222-89819	GHT-2222-89819	NBC-2222-89819
				ABC-2222-89820	DEF-2222-89820	GHT-2222-89820	NBC-2222-89820
				ABC-2222-89821	DEF-2222-89821	GHT-2222-89821	NBC-2222-89821
				ABC-2222-89822	DEF-2222-89822	GHT-2222-89822	NBC-2222-89822
				ABC-2222-89823	DEF-2222-89823	GHT-2222-89823	NBC-2222-89823
				ABC-2222-89824	DEF-2222-89824	GHT-2222-89824	NBC-2222-89824
				ABC-2222-89825	DEF-2222-89825	GHT-2222-89825	NBC-2222-89825
				ABC-2222-89826	DEF-2222-89826	GHT-2222-89826	NBC-2222-89826
				ABC-2222-89827	DEF-2222-89827	GHT-2222-89827	NBC-2222-89827
				ABC-2222-89828	DEF-2222-89828	GHT-2222-89828	NBC-2222-89828
				ABC-2222-89829	DEF-2222-89829	GHT-2222-89829	NBC-2222-89829
				ABC-2222-89830	DEF-2222-89830	GHT-2222-89830	NBC-2222-89830
				ABC-2222-89831	DEF-2222-89831	GHT-2222-89831	NBC-2222-89831
				ABC-2222-89832	DEF-2222-89832	GHT-2222-89832	NBC-2222-89832
				ABC-2222-89833	DEF-2222-89833	GHT-2222-89833	NBC-2222-89833
				ABC-2222-89834	DEF-2222-89834	GHT-2222-89834	NBC-2222-89834
				ABC-2222-89835	DEF-2222-89835	GHT-2222-89835	NBC-2222-89835
				ABC-2222-89836	DEF-2222-89836	GHT-2222-89836	NBC-2222-89836
				ABC-2222-89837	DEF-2222-89837	GHT-2222-89837	NBC-2222-89837
				ABC-2222-89838	DEF-2222-89838	GHT-2222-89838	NBC-2222-89838
				ABC-2222-89839	DEF-2222-89839	GHT-2222-89839	NBC-2222-89839
				ABC-2222-89840	DEF-2222-89840	GHT-2222-89840	NBC-2222-89840

SamKhem · Aug 23, 2024

Fuji said:

try

Code:

Sub test()
    Dim a, b, i&, ii&, n&, x
    With [a1].CurrentRegion.Offset(1)
        .Columns(9).Resize(, .Columns.Count - 8).ClearContents
        a = .Value
        ReDim b(1 To UBound(a, 1) * 8)
        For i = 1 To UBound(a, 1) - 1
            For ii = 5 To 8
                If a(i, ii) <> "" Then n = n + 1: b(n) = a(i, ii)
            Next
        Next
        For i = 1 To UBound(a, 1) - 1
            For ii = 1 To 4
                If a(i, ii) <> "" Then
                    x = Application.Match(a(i, ii), b, 0)
                    If IsNumeric(x) Then
                        a(UBound(a, 1), ii) = a(UBound(a, 1), ii) + 1
                        a(a(UBound(a, 1), ii), ii + 8) = a(i, ii)
                    Else
                        a(UBound(a, 1), ii + 4) = a(UBound(a, 1), ii + 4) + 1
                        a(a(UBound(a, 1), ii + 4), ii + 12) = a(i, ii)
                    End If
                End If
            Next
        Next
        .Resize(.Rows.Count - 1).Value = a
    End With
End Sub

Thank so much for support Fuji. Anyway, I tried your code work work well with small data. I tried big row data it take long time to complete. Could you help this?

Fuji · Aug 23, 2024

Try change to

Code:

Sub test()
    Dim a, i&, ii&, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    With [a1].CurrentRegion.Offset(1)
        .Columns(9).Resize(, .Columns.Count - 8).ClearContents
        a = .Value
        ReDim b(1 To UBound(a, 1) * 8)
        For i = 1 To UBound(a, 1) - 1
            For ii = 5 To 8
                If a(i, ii) <> "" Then dic(a(i, ii)) = Empty
            Next
        Next
        For i = 1 To UBound(a, 1) - 1
            For ii = 1 To 4
                If a(i, ii) <> "" Then
                    If dic.exists(a(i, ii)) Then
                        a(UBound(a, 1), ii) = a(UBound(a, 1), ii) + 1
                        a(a(UBound(a, 1), ii), ii + 8) = a(i, ii)
                    Else
                        a(UBound(a, 1), ii + 4) = a(UBound(a, 1), ii + 4) + 1
                        a(a(UBound(a, 1), ii + 4), ii + 12) = a(i, ii)
                    End If
                End If
            Next
        Next
        .Resize(.Rows.Count - 1).Value = a
    End With
End Sub

SamKhem · Aug 23, 2024

Fuji said:

Try change to

Code:

Sub test()
    Dim a, i&, ii&, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    With [a1].CurrentRegion.Offset(1)
        .Columns(9).Resize(, .Columns.Count - 8).ClearContents
        a = .Value
        ReDim b(1 To UBound(a, 1) * 8)
        For i = 1 To UBound(a, 1) - 1
            For ii = 5 To 8
                If a(i, ii) <> "" Then dic(a(i, ii)) = Empty
            Next
        Next
        For i = 1 To UBound(a, 1) - 1
            For ii = 1 To 4
                If a(i, ii) <> "" Then
                    If dic.exists(a(i, ii)) Then
                        a(UBound(a, 1), ii) = a(UBound(a, 1), ii) + 1
                        a(a(UBound(a, 1), ii), ii + 8) = a(i, ii)
                    Else
                        a(UBound(a, 1), ii + 4) = a(UBound(a, 1), ii + 4) + 1
                        a(a(UBound(a, 1), ii + 4), ii + 12) = a(i, ii)
                    End If
                End If
            Next
        Next
        .Resize(.Rows.Count - 1).Value = a
    End With
End Sub

It's still take to long for applied this code. assume I have around 1 million row for 8 columns so total around 8 million rows.

Fuji · Aug 23, 2024

1 million row

Too much.
This is my last post here,

Code:

Sub test()
    Dim a, c As New Collection, i&, ii&, n&, x
    With [a1].CurrentRegion.Offset(1)
        .Columns(9).Resize(, .Columns.Count - 8).ClearContents
        a = .Value: ReDim b(1 To UBound(a, 1), 1 To 8)
        On Error Resume Next
        For i = 1 To UBound(a, 1) - 1
            For ii = 5 To 8
                If a(i, ii) <> "" Then c.Add ii, CStr(a(i, ii))
            Next
        Next
        On Error GoTo 0
        For i = 1 To UBound(a, 1) - 1
            For ii = 1 To 4
                If a(i, ii) <> "" Then
                    On Error Resume Next
                    x = c(a(i, ii))
                    If Err = 0 Then
                        n = b(UBound(b, 1), ii) + 1
                        b(n, ii) = a(i, ii)
                        b(UBound(b, 1), ii) = n
                    Else
                        n = b(UBound(a, 1), ii + 4) + 1
                        b(n, ii + 4) = a(i, ii)
                        b(UBound(b, 1), ii + 4) = n
                    End If
                    Err.Clear
                End If
            Next
        Next
        .Columns(9).Resize(UBound(b, 1) - 1, UBound(b, 2)) = b
    End With
End Sub

SamKhem · Aug 23, 2024

Thanks for try to support. Let me try again. Have a nice weekend.

Akuini · Aug 23, 2024

@SamKhem
1. Are data in each column unique?
2. Is it ok to sort data in each column?

SamKhem · Aug 23, 2024

Akuini said:
@SamKhem
1. Are data in each column unique?
2. Is it ok to sort data in each column?

1. Some data have different characters such 14 digits, 15 digits, 16 digit.
2. Yes we could sort data.

Akuini · Aug 23, 2024

Try this:
I only include Data1 & Main1 to test the speed. Please, check & show us the completion time in immediate windows. If it's fast enough then I'll write the complete code.

VBA Code:

Sub SamKhem_1()
Dim i As Long, j As Long, n As Long, a As Long, b As Long, k As Long
Dim va, vb, vc

Application.ScreenUpdating = False
t = Timer
x = 1

Columns(x).Sort Key1:=Cells(1, x), Order1:=xlAscending, Header:=xlYes
Columns(x + 4).Sort Key1:=Cells(1, x + 4), Order1:=xlAscending, Header:=xlYes

a = Cells(Rows.Count, 1).End(xlUp).Row
b = Cells(Rows.Count, x + 4).End(xlUp).Row

va = Range(Cells(2, x), Cells(a, x))
vb = Range(Cells(2, x + 4), Cells(b, x + 4))

ReDim vc(1 To UBound(va, 1), 1 To 1)
n = 1
For i = 1 To UBound(va, 1)
    For j = n To UBound(vb, 1)
        If va(i, 1) = vb(j, 1) Then
            k = k + 1
            vc(k, 1) = va(i, 1)
            va(i, 1) = ""
            n = j
            Exit For
        ElseIf va(i, 1) < vb(j, 1) Then
            n = j
            Exit For
        End If
    Next
Next


Cells(2, x + 8).Resize(UBound(vc, 1), 1) = vc
Cells(2, x + 12).Resize(UBound(va, 1), 1) = va
Columns(x + 12).Sort Key1:=Cells(1, x + 12), Order1:=xlAscending, Header:=xlYes

Application.ScreenUpdating = True
Debug.Print "Completion time:  " & Format(Timer - t, "0.00") & " seconds"

End Sub

SamKhem - Match data columns to columns million.xlsm

A

B

C

D

E

F

G

H

I

J

K

L

M

1

Data1

Main 1

Match 1

Different 1

2

ABC098789766

ABC222389780

3

ABC1111123345

ABC222389781

4

ABC2222123345

ABC128589771

ABC2222123345

ABC222389782

5

ABC222289765

ABC2222123345

ABC222289765

ABC222389783

6

ABC222289767

ABC222289765

ABC222289767

7

ABC222289768

ABC222289767

ABC222289768

8

ABC222389780

ABC222289768

9

ABC222389781

ABC222289769

10

ABC222389782

ABC222289770

11

ABC222389783

ABC222289772

Sheet1

SamKhem · Aug 23, 2024

Akuini said:
Try this:
I only include Data1 & Main1 to test the speed. Please, check & show us the completion time in immediate windows. If it's fast enough then I'll write the complete code.

VBA Code:

Sub SamKhem_1() Dim i As Long, j As Long, n As Long, a As Long, b As Long, k As Long Dim va, vb, vc Application.ScreenUpdating = False t = Timer x = 1 Columns(x).Sort Key1:=Cells(1, x), Order1:=xlAscending, Header:=xlYes Columns(x + 4).Sort Key1:=Cells(1, x + 4), Order1:=xlAscending, Header:=xlYes a = Cells(Rows.Count, 1).End(xlUp).Row b = Cells(Rows.Count, x + 4).End(xlUp).Row va = Range(Cells(2, x), Cells(a, x)) vb = Range(Cells(2, x + 4), Cells(b, x + 4)) ReDim vc(1 To UBound(va, 1), 1 To 1) n = 1 For i = 1 To UBound(va, 1) For j = n To UBound(vb, 1) If va(i, 1) = vb(j, 1) Then k = k + 1 vc(k, 1) = va(i, 1) va(i, 1) = "" n = j Exit For ElseIf va(i, 1) < vb(j, 1) Then n = j Exit For End If Next Next Cells(2, x + 8).Resize(UBound(vc, 1), 1) = vc Cells(2, x + 12).Resize(UBound(va, 1), 1) = va Columns(x + 12).Sort Key1:=Cells(1, x + 12), Order1:=xlAscending, Header:=xlYes Application.ScreenUpdating = True Debug.Print "Completion time: " & Format(Timer - t, "0.00") & " seconds" End Sub

SamKhem - Match data columns to columns million.xlsm
A B C D E F G H I J K L M
1 Data1 Main 1 Match 1 Different 1
2 ABC098789766 ABC098789766 ABC098789766 ABC222389780
3 ABC1111123345 ABC1111123345 ABC1111123345 ABC222389781
4 ABC2222123345 ABC128589771 ABC2222123345 ABC222389782
5 ABC222289765 ABC2222123345 ABC222289765 ABC222389783
6 ABC222289767 ABC222289765 ABC222289767
7 ABC222289768 ABC222289767 ABC222289768
8 ABC222389780 ABC222289768
9 ABC222389781 ABC222289769
10 ABC222389782 ABC222289770
11 ABC222389783 ABC222289772
Sheet1

Thanks and let me try and inform you.

SamKhem · Aug 23, 2024

Fuji said:

Too much.
This is my last post here,

Code:

Sub test()
    Dim a, c As New Collection, i&, ii&, n&, x
    With [a1].CurrentRegion.Offset(1)
        .Columns(9).Resize(, .Columns.Count - 8).ClearContents
        a = .Value: ReDim b(1 To UBound(a, 1), 1 To 8)
        On Error Resume Next
        For i = 1 To UBound(a, 1) - 1
            For ii = 5 To 8
                If a(i, ii) <> "" Then c.Add ii, CStr(a(i, ii))
            Next
        Next
        On Error GoTo 0
        For i = 1 To UBound(a, 1) - 1
            For ii = 1 To 4
                If a(i, ii) <> "" Then
                    On Error Resume Next
                    x = c(a(i, ii))
                    If Err = 0 Then
                        n = b(UBound(b, 1), ii) + 1
                        b(n, ii) = a(i, ii)
                        b(UBound(b, 1), ii) = n
                    Else
                        n = b(UBound(a, 1), ii + 4) + 1
                        b(n, ii + 4) = a(i, ii)
                        b(UBound(b, 1), ii + 4) = n
                    End If
                    Err.Clear
                End If
            Next
        Next
        .Columns(9).Resize(UBound(b, 1) - 1, UBound(b, 2)) = b
    End With
End Sub

Dear Fuji, I tried this code work much faster. Thanks

Match data columns to columns million + with scripting dictionary

SamKhem

Board Regular

SamKhem

Board Regular

Excel Facts

Fuji

Active Member

SamKhem

Board Regular

Fuji

Active Member

SamKhem

Board Regular

Akuini

Well-known Member

SamKhem

Board Regular

Akuini

Well-known Member

SamKhem

Board Regular

SamKhem

Board Regular

Similar threads

Forum statistics

Share this page

Match data columns to columns million + with scripting dictionary

Board Regular

Board Regular

Excel Facts

Active Member

Board Regular

Active Member

Board Regular

Well-known Member

Board Regular

Well-known Member

Board Regular

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock