CODEWITHSUNDEEP
arraysvbaexcel
Swolerosis
Swolerosis

Reputation: 93

Building and comparing arrays

I have the below code I'm trying to get to work. This is my first time dealing with arrays in VBA. Here's the plain english version of what I'm going for:

  1. Load SSBarray with column A from worksheet SSB.
  2. Load EDMarray with Column I from worksheet EDM.
  3. Compare the above arrays and sort into two new arrays IDarray and noIDarray based on a possible match.
  4. Output the new arrays into their respective worksheets.

Step 4 is temporary to just make sure the code is even working. The entire project is compiling all the data from 3 sheets into these two lists. Worksheet 1 has Data point A only, Worksheet 2 may or may not have Data point A, B, and/or C, and Worksheet 3 may or may not have Data point A, B, and/or C. The code I have is my start to check for all of the data point A's in worksheet 1 are in worksheet 2. Run time is also a factor. I'll take any and all the help I can get at this point. Thanks.

'Build Arrays
Dim i As Long, j As Long
Dim SSBarray
Dim EDMarray
Dim IDarray
Dim noIDarray
Dim YCounter As Long
Dim NCounter As Long
Dim inArray As Boolean
endSSB = SSB.Range("A" & Rows.Count).End(xlUp).Row
endEDM = EDM.Range("A" & Rows.Count).End(xlUp).Row
BBlast = BB.Range("A" & BB.Range("A" & Rows.Count).End(xlUp).Row)

ReDim SSBarray(1 To endSSB)
ReDim EDMarray(1 To endEDM)

For i = 2 To endSSB
    SSBarray(i) = SSB.Cells(i, 1).Value2
Next i

For i = 2 To endEDM
    EDMarray = EDM.Cells(i, 9).Value2
Next i

For i = 2 To endSSB
    inArray = False
    For j = 2 To endEDM
        If SSBarray(i) = EDMarray(j) Then
            inArray = True
            YCounter = YCounter + 1
            ReDim Preserve IDarray(1 To YCounter)
            IDarray(YCounter) = SSBarray(i)
            Exit For
        End If
    Next j
    If inArray = False Then
        NCounter = NCounter + 1
        ReDim Preserve noIDarray(1 To NCounter)
        noIDarray(NCounter) = SSBarray(i)
    End If
Next i

For i = 1 To UBound(IDarray)
    Identifiers.Cells(i, 4) = IDarray(i)
Next i

For i = 1 To UBound(noIDarray)
    NoIdentifiers.Cells(i, 4) = noIDarray(i)
Next i


End Sub

Revised Code:

'Sort and Compile Data
Dim i As Long

endSSB = SSB.Range("A" & Rows.Count).End(xlUp).Row
endEDM = EDM.Range("A" & Rows.Count).End(xlUp).Row
BBlast = BB.Range("A" & BB.Range("A" & Rows.Count).End(xlUp).Row)

Public Type otherIDs
    SEDOL As Variant
    ISIN As Variant
End Type

Dim SSBIds As New Scripting.Dictionary
Dim IDs As otherIDs
For i = 2 To endSSB
    'Add an ID\row number pair
    SSBIds.Add SSB.Cells(i, 1).Value2
Next i

Dim EDMIds As New Scripting.Dictionary
For i = 2 To endEDM
    IDs.SEDOL = EDM.Cells(i, 8).Value2
    IDs.ISIN = EDM.Cells(i, 7).Value2
    EDMIds.Add EDM.Cells(i, 9).Value2, IDs.SEDOL, IDs.ISIN
Next i

Dim IdMatches As New Scripting.Dictionary
Dim IdMisMatches As New Scripting.Dictionary
Dim key As Variant
For Each key In SSBIds
    'If it's in the other dictionary...
    If EDMIds.Exists(key) Then
        '...add the row to the matches...
        IdMatches.Add key, EDMIds(key)
    Else
        '...otherwise add the row to the mismatches.
        IdMisMatches.Add key, EDMIds(key)
    End If
Next

i = 1
For Each key In IdMatches.Keys
    Identifiers.Cells(i, 4) = key
    Identifiers.Cells(i, 5) = IdMatches.IDs.SEDOL
    Identifier.Cells(i, 6) = IdMatches.IDs.ISIN
    i = i + 1
Next

i = 1
For Each key In IdMisMatches.Keys
    NoIdentifiers.Cells(i, 4) = key
    i = i + 1
Next

Upvotes: 2

Views: 94

Answers (1)

Comintern
Comintern

Reputation: 22195

Arrays aren't the best containers to be using here. Dictionaries have an .Exists method that uses a much faster hash lookup than a simple iteration that compares every value.

Not only that, repeatedly calling Redim Preserve is incredibly inefficient compared to adding items to a Dictionary. Every time you increase the array dimension, the entire data set gets copied to a newly allocated area of memory and the data pointer for the array gets updated to point to it.

Example using Dictionaries (you'll need to add a reference to Microsoft Scripting Runtime):

Dim SSBIds As New Scripting.Dictionary
For i = 2 To endSSB
    'Add an ID\row number pair
    SSBIds.Add SSB.Cells(i, 1).Value2, i
Next i

Dim EDMIds As New Scripting.Dictionary
For i = 2 To endEDM
    EDMIds.Add EDM.Cells(i, 9).Value2, i
Next i

Dim IdMatches As New Scripting.Dictionary
Dim IdMisMatches As New Scripting.Dictionary
Dim key As Variant
For Each key In SSBIds
    'If it's in the other dictionary...
    If EDMIds.Exists(key) Then
        '...add the row to the matches...
        IdMatches.Add key, EDMIds(key)
    Else
        '...otherwise add the row to the mismatches.
        IdMisMatches.Add key, EDMIds(key)
    End If
Next

i = 1
For Each key In IdMatches.Keys
    Identifiers.Cells(i, 4) = key
    i = i + 1
Next

i = 1
For Each key In IdMisMatches.Keys
    NoIdentifiers.Cells(i, 4) = key
    i = i + 1
Next

Note that this assumes that your key columns have unique values. If they don't, you can either test for the presence of the key before adding a value (this matches your code's behavior of only taking the first match), or you can create a Collection of values to store in the Dictionary for each key, or something else entirely depending on your requirement.

Upvotes: 5

Related Questions