Combining data using nested For/Next loops but EXCEL keeps crashing!!!

[logandiana]

I am trying to combine multiple entries on multiple columns to create one long list.
I am using nested For Next loops. The code does exactly what I want it to do as I step through it, but crashes Excel every time when I run it outright.
Not sure what I need to do differently.
The data is similar to this:
1st data
1 ABC
1 DEF
1 GHI
2 CBA
2 FED
2 IHG

2nd data
1 XYZ
1 ZYX
2 LMN
2 NML

End data needed
1 XYZ ABC
1 XYZ DEF
1 XYZ GHI
1 ZYX ABC
1 ZYX DEF
1 ZYX GHI
2 LMN CBA
2 LMN FED
2 LMN IHG
2 NML CBA
2 NML FED
2 NML IHG


On the orders tab (Ord) I have 4 columns and a total of 3784 lines. On the mail tab (mail) I have 2 columns with 20764 lines. The total unique lines at the end should be 33072.
Here's my code.

Dim j as Long
Dim k as Long
LR4 = Ord.Cells(Rows.Count, 1).End(xlUp).Row
LR5 = mail.Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To LR5
    For k = 2 To LR4
        If Ord.Cells(k, 1) = mail.Cells(j, 1) Then
        Range(Ord.Cells(k, 2), Ord.Cells(k, 5)).Copy
        Range("F" & mail.Cells(Rows.Count, 6).End(xlUp).Row).Offset(1, 0).PasteSpecial xlPasteValues
        Range("D" & mail.Cells(Rows.Count, 4).End(xlUp).Row).Offset(1, 0).Value = mail.Cells(j, 1).Value
        Range("E" & mail.Cells(Rows.Count, 5).End(xlUp).Row).Offset(1, 0).Value = mail.Cells(j, 2).Value
    End If
    Next k
Next j

I keep getting a message that "excel has stopped working and will restart"

 

[AlphaFrog]

    [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] j [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] k [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] vOrd [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    [color=darkblue]Dim[/color] vMail [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    [color=darkblue]Dim[/color] vResult [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    
    vOrd = ord.Range("A2:F" & ord.Cells(Rows.Count, 1).End(xlUp).Row)
    vMail = mail.Range("A2:B" & mail.Cells(Rows.Count, 1).End(xlUp).Row)
    
    [color=darkblue]ReDim[/color] vResult(1 [color=darkblue]To[/color] (UBound(vOrd, 1) * [color=darkblue]UBound[/color](vMail, 1)), 1 [color=darkblue]To[/color] 6)
    
    [color=darkblue]With[/color] CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        [color=darkblue]For[/color] i = [color=darkblue]LBound[/color](vOrd, 1) [color=darkblue]To[/color] [color=darkblue]UBound[/color](vOrd, 1)
            [color=darkblue]If[/color] [color=darkblue]Not[/color] .Exists(vOrd(i, 1)) [color=darkblue]Then[/color] .Add vOrd(i, 1), CreateObject("Scripting.Dictionary")
            .Item(vOrd(i, 1)).Add vOrd(i, 2), Application.Index(vOrd, i, Array(3, 4, 5))
        [color=darkblue]Next[/color] i
        
        [color=darkblue]For[/color] i = [color=darkblue]LBound[/color](vMail, 1) [color=darkblue]To[/color] UBound(vMail, 1)
            [color=darkblue]If[/color] .Exists(vMail(i, 1)) [color=darkblue]Then[/color]
                [color=darkblue]For[/color] [color=darkblue]Each[/color] MailItm [color=darkblue]In[/color] .Item(vMail(i, 1))
                    j = j + 1
                    vResult(j, 1) = vMail(i, 1)
                    vResult(j, 2) = vMail(i, 2)
                    vResult(j, 3) = MailItm
                    k = 4
                    [color=darkblue]For[/color] [color=darkblue]Each[/color] itm [color=darkblue]In[/color] .Item(vMail(i, 1)).Item(MailItm)
                        vResult(j, k) = itm
                        k = k + 1
                    [color=darkblue]Next[/color]
                [color=darkblue]Next[/color]
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]Next[/color] i
        
        mail.Range("D" & mail.Cells(Rows.Count, 4).End(xlUp).Row).Offset(1, 0).Resize(j, 6).Value = vResult
        
    [color=darkblue]End[/color] [color=darkblue]With[/color]

 

[logandiana]

    [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] j [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] k [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] vOrd [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] vMail [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] vResult [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
    
    vOrd = ord.Range("A2:F" & ord.Cells(Rows.Count, 1).End(xlUp).Row)
    vMail = mail.Range("A2:B" & mail.Cells(Rows.Count, 1).End(xlUp).Row)
    
    [COLOR=darkblue]ReDim[/COLOR] vResult(1 [COLOR=darkblue]To[/COLOR] (UBound(vOrd, 1) * [COLOR=darkblue]UBound[/COLOR](vMail, 1)), 1 [COLOR=darkblue]To[/COLOR] 6)

Stops here, Run time error7, Out of memory

I would try tweak and troubleshoot, but I have no idea what I am even looking at.