A bit complicated.. at least for me

[newbie777]

Hi all,

I have this specific task at work which I failed to do with VBA. So let me explain and even put a link to my file.

I have the below arrays:

Alpha: Includes a lot of Index Code|Exchange Code (Separated by "|")
Beta: Includes a lot of Date| Exchange code (Seprated by "|")

What is needed?
1) Alpha Array has duplicates, i.e same exact elements repeated which needs to be omitted from Alpha Array.
2) Whenever there is a match between the exchange code in array Alpha and array Beta, we add the index code from array Alpha + "|" + Date from array Beta to a new array THETA.

Please note that there should be more than one match and I need all of them.

Can you Please help me as soon as possible with a code that can do the above? I would really appreciate if there is explanation as well.

https://app.box.com/s/jde0deo8qqccxsy6fqm0x5wpc4k7a3vb

Many thanks in advance.
Best,

 

[DanteAmor]

First you must remove the duplicates from the "EOD Reports" sheet. I already did it and put them on the "Alpha" sheet.
On the "Theta" sheet I put a button to execute the macro.

Sub Fill_Theta()
'
    Dim h1 As Worksheet, h2 As Worksheet, h3 As Worksheet
    Dim k As Double, i As Double, u1 As Double
    Dim celda As String, r As Range, b As Object
    '
    Application.ScreenUpdating = False
    Set h1 = Sheets("Alpha")
    Set h2 = Sheets("Report")
    Set h3 = Sheets("Theta")
    '
    k = 2
    h3.Rows("2:" & Rows.Count).ClearContents
    u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To u1
        Set r = h2.Columns("S")
        Set b = r.Find(h1.Cells(i, "B"), LookAt:=xlWhole)
        If Not b Is Nothing Then
            celda = b.Address
            Do
                h3.Cells(k, "A").Value = h1.Cells(i, "B").Value
                h3.Cells(k, "B").Value = h1.Cells(i, "A").Value & "|" & h2.Cells(b.Row, "A").Value
                k = k + 1
                Set b = r.FindNext(b)
            Loop While Not b Is Nothing And b.Address <> celda
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "End"
End Sub

See the file:

https://www.dropbox.com/s/z7ii1gbb1gdzjg2/Mind blowing dam.xlsm?dl=0

Regards Dante Amor