VBA - Merging two or more arrays using a unique ID

[Manawydan]

Hi all,

I'm hoping someone can help with an issue I have. I want to change how I merge multiple arrays using a unique ID. I was initially able to do this via a solution I saw on this board ( VBA Macro - Merge Worksheets Columns using Unique ID ) which initially worked. However, my data has got to the point it is too large to do this via sheets due to the time it takes. To try and speed things up, I read the data from multiple sheets and then use loops to check the data, but there must be a quicker way to do this. My current script is :

Sub MergeData()

    Dim vMain As Variant
    Dim vStage As Variant
    Dim vi1 As Long
    Dim vi2 As Long
    Dim vLastRow As Long
            
    vLastRow = ActiveWorkbook.Sheets("Main Sheet").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    vMain = Sheets("Main Sheet").Range("A2:C" & vLastRow).Value
    
    ReDim Preserve vMain(LBound(vMain) To UBound(vMain), LBound(vMain, 2) To UBound(vMain, 2) + 2)
    
    vLastRow = ActiveWorkbook.Sheets("Stage").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    vStage = Sheets("Stage").Range("A2:C" & vLastRow).Value
    
    For vi1 = 1 To UBound(vMain)
    
        For vi2 = 1 To UBound(vStage)
                
            If vStage(vi2, 1) = vMain(vi1, 1) Then
            
                vMain(vi1, 3) = vStage(vi2, 2)
                vMain(vi1, 4) = vStage(vi2, 3)
                
            End If
        
        Next vi2
        
    Next vi1

    Sheets("Main Sheet").Range("A2:D" & UBound(vMain) + 1).Value = vMain

End Sub

An example of data is

Main Sheet

ID	Name
AA1	Jean Luc Picard
BB2	Frodo Baggins
CC3	Tony Stark

Stage

ID	Stage	Date
AA1	Open	01/08/2020
BB2	Reffered	02/08/2020
CC3	Withdrawn	03/08/2020

Update Main Sheet

ID	Name	Stage	Date
AA1	Jean Luc Picard	Open	01/08/2020
BB2	Frodo Baggins	Reffered	02/08/2020
CC3	Tony Stark	Withdrawn	03/08/2020

I have 15 sheets combine with over 12,000 rows per sheet and various columns, so I was hoping that running it all through arrays would be quicker. Has anyone got any advice how to speed this up without checking each array row from the extra sheets over and over again, please? ( Not in Power Query, I need to create a script as others will be running this )

Thank you

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub MergeData()

   Dim vMain As Variant
   Dim vStage As Variant
   Dim vi1 As Long
   Dim vi2 As Long
   Dim vLastRow As Long
   
   vLastRow = ActiveWorkbook.Sheets("Main Sheet").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   
   vMain = Sheets("Main Sheet").Range("A2:D" & vLastRow).Value
   
   vLastRow = ActiveWorkbook.Sheets("Stage").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   
   vStage = Sheets("Stage").Range("A2:C" & vLastRow).Value
   With CreateObject("scripting.dictionary")
      For vi2 = 1 To UBound(vStage)
         .Item(vStage(vi2, 1)) = vi2
      Next vi2
      For vi1 = 1 To UBound(vMain)
         If .Exists(vMain(vi1, 1)) Then
            vMain(vi1, 3) = vStage(.Item(vMain(vi1, 1)), 2)
            vMain(vi1, 4) = vStage(.Item(vMain(vi1, 1)), 3)
         End If
      Next vi2
   End With
   Sheets("Main Sheet").Range("A2:D" & UBound(vMain) + 1).Value = vMain

End Sub

 

[Manawydan]

Thank you, Fluff, for the welcome and taking the time to reply with the solution. This is amazing and works like a dream ( though I had to make one very small change to run the second loop, Next vi2 to Next vi1, only mentioning just in case someone else is looking for the same solution ) and has already got me researching how else I can use this to help with some other work.

Thank you very much.

Hi & welcome to MrExcel.
How about

Sub MergeData()

   Dim vMain As Variant
   Dim vStage As Variant
   Dim vi1 As Long
   Dim vi2 As Long
   Dim vLastRow As Long
  
   vLastRow = ActiveWorkbook.Sheets("Main Sheet").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  
   vMain = Sheets("Main Sheet").Range("A2:D" & vLastRow).Value
  
   vLastRow = ActiveWorkbook.Sheets("Stage").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  
   vStage = Sheets("Stage").Range("A2:C" & vLastRow).Value
   With CreateObject("scripting.dictionary")
      For vi2 = 1 To UBound(vStage)
         .Item(vStage(vi2, 1)) = vi2
      Next vi2
      For vi1 = 1 To UBound(vMain)
         If .Exists(vMain(vi1, 1)) Then
            vMain(vi1, 3) = vStage(.Item(vMain(vi1, 1)), 2)
            vMain(vi1, 4) = vStage(.Item(vMain(vi1, 1)), 3)
         End If
      Next vi2
   End With
   Sheets("Main Sheet").Range("A2:D" & UBound(vMain) + 1).Value = vMain

End Sub

 

[Fluff]

You're welcome & thanks for the feedback.

 

[ZeroTrinder]

Good Afternoon Fluff,

I have been searching for a while for a similar solution but I am still having issues.

Basically I have 2 sheets that need combining,

"Sanding Report"
This contains a date and time in Column A, an ID number in B, a Sand location in C.

"Sheet1"
This contains an ID number in A (which is the common data), a diagram ID in B, ID code in C, Location in D and Location arrival time and date in E.

Basically I am trying to get a 3rd sheet created called "Sanding Overview" which has:

ID number in A, the sanding report sand location in B, sanding report date and time in C, Diagram ID in D, ID Code in E, Sheet1 Location in F and Location arrival time in G.

I know this is a massive ask and i really appreciate you just reading this!

If you can help it would be very much appreciated!

Kind regards,

Zero

You're welcome & thanks for the feedback.

 

[Fluff]

Please start a thread of your own for this. Thanks
When you do that please supply some sample data of both sheets using the XL2BB add-in.