Excel VBA Get Unique Values

Question

I have 2 arrays: DirCurrentArray and DirHistoryArray but I can't seem to get the values in DirCurrentArray unique from DirHistoryArray

Dim DirCurrentArray As String
Dim DirHistoryArray As Variant

'Gets Filenames into Array
Do While xFile <> ""
    DirCurrentArray(fileCount) = xFile
    xFile = Dir$
    fileCount = fileCount + 1
Loop

For Each i In DirCurrentArray
        For Each j In DirHistoryArray
            If i = j Then
                finalCount = finalCount + 1
                DirFinalArray(finalCount) = i
            End If
        Next j
    Next i

The result I want is the DirCurrentyArray with any values that are found in DirHistoryArray removed

I wish I could understand

DisplayName
– DisplayName

2018-07-03 22:01:13 +00:00
Commented Jul 3, 2018 at 22:01 — DisplayName
– DisplayName, Commented Jul 3, 2018 at 22:01

score 3 · Accepted Answer · 2018-07-05 16:27:50Z

3

The validity of this code will depend somewhat on the nature of the data you are comparing as text based values may produce false positives on partial matches like a wildcarded search. Even a 1 will find a filter match in 11 or 15, etc. I've added 'whole word' matching using the worksheet's Match function as an alternative.

Option Explicit

Sub ytrte()
    Dim DirCurrentArray As Variant, DirHistoryArray As Variant
    Dim i As Long, k As Variant, DirNewArray As Variant

    DirCurrentArray = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 0)
    DirHistoryArray = Array(3, 4, 5, 6, 7, 8, 11)

    ReDim DirNewArray(0)
    i = 0

    ' 'wildcard' matching
    For Each k In DirCurrentArray
        If UBound(Filter(DirHistoryArray, k, True, vbBinaryCompare)) < 0 Then
            ReDim Preserve DirNewArray(i)
            DirNewArray(i) = k
            i = i + 1
        End If
    Next k

    If Not IsEmpty(DirNewArray(LBound(DirNewArray))) Then
        For i = LBound(DirNewArray) To UBound(DirNewArray)
            Debug.Print DirNewArray(i)
        Next i
    End If

'contents of DirNewArray
 2 
 9 
 0 

    ReDim DirNewArray(0)
    i = 0

    ' 'whole word' matching
    For Each k In DirCurrentArray
        If IsError(Application.Match(k, DirHistoryArray, 0)) Then
            ReDim Preserve DirNewArray(i)
            DirNewArray(i) = k
            i = i + 1
        End If
    Next k

    If Not IsEmpty(DirNewArray(LBound(DirNewArray))) Then
        For i = LBound(DirNewArray) To UBound(DirNewArray)
            Debug.Print DirNewArray(i)
        Next i
    End If
'contents of DirNewArray
 1 
 2 
 9 
 0 

End Sub

Adjusted loop to fill file names.

Dim DirCurrentArray() As Variant
Dim fileCount As long
...
'Gets Filenames into Array
fileCount = 0
Do While xFile <> ""
    redim preserve DirCurrentArray(fileCount)
    DirCurrentArray(fileCount) = xFile
    fileCount = fileCount + 1
    xFile = Dir$
Loop

edited Jul 5, 2018 at 16:27

answered Jul 3, 2018 at 22:18

user4039065

Sign up to request clarification or add additional context in comments.

8 Comments

Chris Y Over a year ago

The issue I'm having is DirCurrentArray is a String Array. Both DirCurrentArray and DirHistoryArray are filenames (e.g. text). I need exact matches.

user4039065 Over a year ago

Well the latter method I provided would seem to support that.

Chris Y Over a year ago

You're right about the whole word, but the issue is I have Dim DirCurrentArray As String and I think you're expecting As Variant so I get a mismatch when getting to: "For Each k In DirCurrentArray"

user4039065 Over a year ago

That's true. I find working in anything but a variant array restrictive. Same goes for dictionaries and collections which are of variant type. Of course, you could always write your own string based loop.

Chris Y Over a year ago

Thanks. That's a good best practice to get used to. I added code to my original question. The only reason I went with a String was because that's the only way I knew to get filenames from a directory into an array. Is there any easy way to pull in filenames into a variant?

|

Subodh Tiwari sktneer · Accepted Answer · 2018-07-04 05:05:29Z

I think you can use Dictionary to store, compare and retrieve the array items as per your requirement.

You may try something like this...

Dim dict
Set dict = CreateObject("Scripting.Dictionary")

'Load DirCurrentArray into dictionary
For i = LBound(DirCurrentArray) To UBound(DirCurrentArray)
    dict.Item(DirCurrentArray(i)) = ""
Next i

'Remove from dictionary if DirHistoryArray elements are found in dictionary
For i = LBound(DirHistoryArray) To UBound(DirHistoryArray)
    If dict.exists(DirHistoryArray(i)) Then dict.Remove (DirHistoryArray(i))
Next i

'If dictionary is not empty then populate the DirCurrentArray with dictionary keys
If dict.Count Then
    DirCurrentArray = dict.keys
    MsgBox Join(DirCurrentArray, ", ")
Else
    MsgBox "DirCurrentArray is empty."
End If

TinMan · Accepted Answer · 2018-07-04 00:17:06Z

0

Collections are built to lookup unique values. My code first adds all the values in DirCurrentArray to an ArrayList and then removes all values in DirHistoryArray from the ArrayList. Finally, it assigns the values in the ArrayList to DirFinalArray.

Sub GetUniqueValuesFrom2Arrays()
    Dim DirCurrentArray As Variant, DirHistoryArray As Variant, DirFinalArray, Key As Variant
    Dim list As Object
    Set list = CreateObject("System.Collections.ArrayList")

    Dim i As Long, k As Variant, DirNewArray As Variant

    DirCurrentArray = Array("A", "B", "C", 1, 2, 3, 4, 5)
    DirHistoryArray = Array("C", "D", 1, 3, 5)

    For Each Key In DirCurrentArray
        list.Add Key
    Next

    For Each Key In DirHistoryArray
        If list.Contains(Key) Then list.Remove Key
    Next

    DirFinalArray = list.ToArray()

    MsgBox "DirCurrentArray: " & Join(DirCurrentArray, ",") & vbNewLine & _
        "DirCurrentArray: " & Join(DirHistoryArray, ",") & vbNewLine & _
        "DirFinalArray: " & Join(DirFinalArray, ",")

End Sub

answered Jul 4, 2018 at 0:17

TinMan

7,8142 gold badges13 silver badges24 bronze badges

1 Comment

Chris Y Over a year ago

The issue I'm having is DirCurrentArray is a String Array. Both DirCurrentArray and DirHistoryArray are filenames (e.g. text). I need exact matches. I'm not familiar enough with how to pull in the filenames to a Variant object so it pulls into DirCurrentArray which is a String array

Santosh · Accepted Answer · 2018-07-04 05:29:51Z

Check this out

Option Base 1
Sub test()

    Dim DirCurrentArray(5) As Integer
    Dim DirHistoryArray(5) As Integer
    Dim DirFinalArray() As Integer


    DirCurrentArray(1) = 1
    DirCurrentArray(2) = 4
    DirCurrentArray(3) = 5
    DirCurrentArray(4) = 1
    DirCurrentArray(5) = 7


    DirHistoryArray(1) = 1
    DirHistoryArray(2) = 2
    DirHistoryArray(3) = 1
    DirHistoryArray(4) = 4
    DirHistoryArray(5) = 1

    Dim blnExist As Boolean

    For Each i In DirCurrentArray
        For Each j In DirHistoryArray

            If i = j Then
                blnExist = True
                Exit For
            End If

        Next

        If blnExist = False Then
            finalcount = finalcount + 1
            ReDim Preserve DirFinalArray(finalcount)
            DirFinalArray(finalcount) = i
        End If

        blnExist = False
    Next


End Sub

Collectives™ on Stack Overflow

Excel VBA Get Unique Values

4 Answers 4

8 Comments

Comments

1 Comment

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

4 Answers 4

8 Comments

Comments

1 Comment

Comments

Your Answer

Sign up or log in

Post as a guest

Related