CODEWITHSUNDEEP
arraysvbaexcelexcel-2010
Gordon King
Gordon King

Reputation: 37

Scan through multiple ranges and store unique value pairs into an array

I am trying to scan through two columns (one which is formatted to text and the other column is a custom format; not sure if this matters, but just in case) and I want to write a snippet of VBA to have this array only contain unique pairs.

enter image description here

I hope to cycle through the table in order to compare each element of the table with the unique values of this array so that I can perform some sorting operation.

The end result should be 

ScanArray = Array("Per SA","Per SB", "Per SC", "Per FC", "Mod SC", "Mod SB", "Mod SA", "Mod FC", "SP SA", "SP SB", "SP SC", "SP FC")

...with spaces to separate out the two distinct elements

My code below for trying to intake two ranges into my array - but it's not working as I had hoped...

 Option Explicit

 Sub ArrayFill()

 Dim WkSht1 As Worksheet
 Dim ScanArray As Variant
 Dim k As Integer

 Set WkSht1 = Worksheets("Cashflow")
 'the compiler definitely doesn't like this
 ScanArray = WkSht1.Range("C3", Range("D36")).RemoveDuplicates 

 For k = LBound(ScanArray) To UBound(ScanArray)

'Do Until Something
    'If matching function Then
    'MsgBox ScanArray(k)
    'End If
'Loop
Next k

End Sub

Upvotes: 0

Views: 853

Answers (1)

Swastik Padhi
Swastik Padhi

Reputation: 1909

This should work for you- 

Option Explicit

Sub ArrayFill()
    'Populates the array in the format as specified by the question
    Dim WkSht1, tmpSht As Worksheet
    Dim ScanArray() As String
    Dim i, iCntr, lRow, n As Long

    Set WkSht1 = Worksheets("Cashflow")
    n = WkSht1.Range("C1" , WkSht1.Range("C1").End(xlDown)).Rows.Count
    ReDim ScanArray(n-1)
    For i = 1 To n
        ScanArray(i-1) = WkSht1.Cells(i,3).Value & " " & WkSht1.Cells(i,4).Value
    Next i

    'Removes duplicate entries from the array
    Set tmpSht = ThisWorkbook.Worksheets.Add
    For iCntr = 0 To UBound(ScanArray)
        tmpSht.Cells(iCntr + 1, 1).Value = ScanArray(iCntr)
    Next
    tmpSht.Columns(1).RemoveDuplicates Columns:=Array(1)
    lRow = tmpSht.Range("A1").End(xlDown).Row
    ReDim ScanArray(lRow-1)
    For iCntr = 0 To UBound(ScanArray)
        ScanArray(iCntr) = tmpSht.Cells(iCntr + 1, 1).Value
    Next
    Application.DisplayAlerts = False
    tmpSht.Delete
    Application.DisplayAlerts = True
End Sub()

Upvotes: 1

Related Questions