Excel VBA Manipulating data in array is taking long time

[kashif.special2005]

I All,

I have two sheets 1st is called "AADB" and second is called "MDT Access"


AADB have around 200000 rows and 20 columns data, and MDT Access have around 2000 rows and 5 columns data


I want to updating the sheet "Result" with data on below conditions.


I am applying loop on each row in the sheet AADB and in the column 2, if that loop cell column 2 value is available in the sheet MDT Access column 1 and if loop cell column 13 value from the sheet AADB is available in the sheet MDT Access column 4 then update the array with the loop row data of all columns of the sheet AADB.

Note:- FundID are duplicates in both the sheet.

FundID is Column 2 in The sheet AADB, and FundID is column 2 in MDT Access.

Sub QCCombineArrays()
    Dim varAADBinfo As Variant, MDTPIAccessInfo As Variant, varCombineArray As Variant
    Dim LastRow As Long, intdisplayrow As Long, Row As Long, Y As Long
    
    LastRow = Sheets("AADB").Cells(Rows.Count, "A").End(xlUp).Row
    varAADBinfo = Sheets("AADB").Range("A3:S" & LastRow).Value2
    
    LastRow = Sheets("MDT Access").Cells(Rows.Count, "A").End(xlUp).Row
    MDTPIAccessInfo = Sheets("MDT Access").Range("A3:E" & LastRow).Value2
    
    ReDim varCombineArray(UBound(varAADBinfo, 1), UBound(varAADBinfo, 2)) As Variant

    For Row = 1 To UBound(MDTPIAccessInfo, 1)
    
        For Y = 1 To UBound(varAADBinfo, 1)
           
            'varAADBinfo(, 2)=FundID
            'MDTPIAccessInfo(, 1)=FundID
            'varAADBinfo(, 14)=Trans_Date
            'MDTPIAccessInfo(, 3)=TransDate
            If varAADBinfo(Y, 2) = MDTPIAccessInfo(Row, 1) And varAADBinfo(Y, 14) = MDTPIAccessInfo(Row, 3) Then
            
                    'AADB info
                    For Column = 1 To UBound(varAADBinfo, 2)
                        varCombineArray(intdisplayrow, Column) = varAADBinfo(Y, Column)
                    Next Column
                    
                    'QCer info from PI Database
                    'MDTPIAccessInfo(Row, 4)=QCPerson
                    varCombineArray(intdisplayrow, 11) = MDTPIAccessInfo(Row, 4)
                    intdisplayrow = intdisplayrow + 1
            End If
        Next Y
    Next Row
    ActiveSheet.Range(Cells(14, 2), Cells(UBound(varCombineArray, 1) + 14, UBound(varCombineArray, 2) + 2)) = varCombineArray
    
End Sub

Please kindly request to all excel experts please help me on this problem.



Thanks in advance.



Thanks
Kashif

 

[Fluff]

Untested, but how about

Sub kashifspecial2005()
   Dim MDTary As Variant, AADBary As Variant, Outary As Variant
   Dim r As Long, c As Long, rr As Long
   
   With Sheets("MDT")
      MDTary = .Range("A3", .Range("A" & Rows.Count).End(xlUp).Offset(, 4)).Value2
   End With
   With Sheets("AADB")
      AADBary = .Range("A3", .Range("A" & Rows.Count).End(xlUp).Offset(, 14)).Value2
   End With
   ReDim Outary(1 To UBound(AADBary), 1 To UBound(AADBary, 2))
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(MDTary)
         .Item(MDTary(r, 1) & "|" & MDTary(r, 3)) = Empty
      Next r
      For r = 1 To UBound(AADBary)
         If .Exists(AADBary(r, 2) & "|" & AADBary(r, 14)) Then
            rr = rr + 1
            For c = 1 To UBound(AADBary, 2)
               Outary(rr, c) = AADBary(r, c)
            Next c
         End If
      Next r
   End With
   Range("B14").Resize(rr, UBound(AADBary, 2)).Value2 = Outary
End Sub

 

[kashif.special2005]

Hi Fluff,

Thank you so much for reply, yes I have tested the code and it producing the same result as my code.
However I have one concern here you are generating a unique key in the dictionary object, and if there is duplicate combination of FundId and the date then it will replace the first key, but this not my code is doing if there is duplicate combination again then it will again add those details in the array.


Can it is possible in your code?


Thanks once again for your reply.



Thanks
Kashif

 

[Fluff]

Duplicates shouldn't be a problem, because it will copy each row from the AADB sheet if cols 2/14 match cols 1/3 on the MDT sheet.

 

[kashif.special2005]

Hi Fluff,

Thanks for reply, I am saying that there may be duplicate values in the sheet MDT for column 1 and 3.

Let me explain


For example suppose I have data in AADB like below

FundID Date
1 1/05/2019
1 1/05/2019
2 2/04/2019

and suppose I have data in MDT like below

FundID Date
1 1/05/2019
1 1/05/2019
2 2/04/2019
4 5/02/2019

The the output should be like below.

FundID Date
1 1/05/2019
1 1/05/2019
1 1/05/2019
1 1/05/2019
2 2/04/2019

Because you can notice that FundID 1 and Date 1/05/2019 are repeating in the MDT sheet.

However your code generating the following results

FundID Date
1 1/05/2019
1 1/05/2019
2 2/04/2019

Thanks
Kashif

 

[Fluff]

Ok, how about

Sub kashifspecial2005()
   Dim MDTary As Variant, AADBary As Variant, Outary As Variant
   Dim r As Long, c As Long, rr As Long
   
   With Sheets("MDT")
      MDTary = .Range("A3", .Range("A" & Rows.Count).End(xlUp).Offset(, 4)).Value2
   End With
   With Sheets("AADB")
      AADBary = .Range("A3", .Range("A" & Rows.Count).End(xlUp).Offset(, 14)).Value2
   End With
   ReDim Outary(1 To UBound(AADBary) * UBound(MDTary), 1 To UBound(AADBary, 2))
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(MDTary)
         .Item(MDTary(r, 1) & "|" & MDTary(r, 3)) = .Item(MDTary(r, 1) & "|" & MDTary(r, 3)) + 1
      Next r
      For r = 1 To UBound(AADBary)
         If .Exists(AADBary(r, 2) & "|" & AADBary(r, 14)) Then
            For i = 1 To .Item(AADBary(r, 2) & "|" & AADBary(r, 14))
               rr = rr + 1
               For c = 1 To UBound(AADBary, 2)
                  Outary(rr, c) = AADBary(r, c)
               Next c
            Next i
         End If
      Next r
   End With
   Range("B14").Resize(rr, UBound(AADBary, 2)).Value2 = Outary
End Sub

 

[kashif.special2005]

Hi Fluff,

Thank you so much, it is working accordingly.

Many many thanks to you.

Thanks
Kashif

 

[Fluff]

You're welcome & thanks for the feedback