A bit complicated.. at least for me

newbie777

New Member
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

Well-known Member
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.

Code:
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
 

Some videos you may like

This Week's Hot Topics

  • Importing multiple excel files into one spreadsheet
    Hi, I'm trying to import multiple excel files (with the same format into a single spreadsheet) so that each day's file is listed underneath the...
  • find many based on a certain criteria
    good evening, I hope someone can help me? I have a workbook sheet 2 contains lots of data.... I would like to be able to find anything on sheet...
  • How to copy multiple rows using If
    Hi all, I'm very new to VBA and have written this simple code to copy certain cells if a certain cell within that row contains any data. I need...
  • VBA If statement
    Dear All, I have two dates, where I'd like a message box to pop, if the dates are between this criteria. [CODE] sDate1 = #10/1/2019#...
  • Text Format
    I have a sheet for user to keyin the data. The format of the data can be 451 / 1903, 0012 / 9908 or 00287 / 0099. The number after the "/" is...
  • Syntax errors
    Good Morning, Trying to compile a workbook, I keep getting a few errors. Here are the first two: [code=rich]Syntax Error: Function...
Top