Remove duplicates from a string array using excel VBA

user_7330588 0
Viewed 289

I have the following VBA code in Excel 2010 that reads the numbers in column A into a comma separated string. The numbers are sorted in column A

However, I was wondering if there was a way to either remove the duplicate numbers while reading them to to the comma separated variable, or a way to remove all the duplicates from the variable after it has been built.

Here is my code that builds the comma separated list

Dim LR As Long

    Dim RangeOutput
    Dim entry As Variant
    Dim FinalResult As String
    
    LR = Range("A" & Rows.Count).End(xlUp).Row
        On Error Resume Next    'if only 1 row
    
    For Each entry In ThisWorkbook.Sheets("Sheet1").Range("A2:A" & LR)
        If Not IsEmpty(entry.Value) Then
            RangeOutput = RangeOutput & entry.Value & ","
        End If
    Next

    FinalResult = Left(RangeOutput, Len(RangeOutput) - 1)
vba excel
2 Answers

This is how you can do it with a dictionary.

Dim arrData As Variant
Dim dic As Object
Dim idx As Long
    
    arrData = Range("A2").CurrentRegion.Columns(1).Value
    
    Set dic = CreateObject("Scripting.Dictionary")
    
    For idx = 2 To UBound(arrData, 1)
        If arrData(idx, 1) <> "" Then
            dic(arrData(idx, 1)) = ""
        End If
    Next idx

    FinalResult = Join(dic.keys, ",")
user_28500260

You can use a Collection to achieve same result:

Option Explicit

Sub Test()
    Dim ws As Worksheet
    '
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    On Error GoTo 0
    If ws Is Nothing Then
        MsgBox "Missing required worksheet", vbExclamation, "Cancelled"
        Exit Sub
    End If
    '
    Dim lastRowIndex As Long
    '
    lastRowIndex = ws.Range("A" & Rows.Count).End(xlUp).Row 'Notice the range is fully referenced with the sheet
    If lastRowIndex = 1 Then
        MsgBox "No data found in column A", vbInformation, "Cancelled"
        Exit Sub
    End If
    '
    Dim arrValues As Variant
    '
    arrValues = ws.Range("A2:A" & lastRowIndex).Value2
    If Not IsArray(arrValues) Then arrValues = Array(arrValues) 'Just in case lastRow is 2
    '
    Dim v As Variant
    Dim uniqueValues As New Collection
    '
    On Error Resume Next 'For duplicated values - collections do not allow duplicated keys
    For Each v In arrValues
        uniqueValues.Add v, CStr(v)
    Next v
    On Error GoTo 0
    '
    Dim arrResult() As Variant
    Dim i As Long
    Dim result As String
    '
    ReDim arrResult(0 To uniqueValues.Count - 1)
    i = 0
    For Each v In uniqueValues
        arrResult(i) = CStr(v) 'In case there are errors like #N/A
        i = i + 1
    Next v
    '
    result = Join(arrResult, ",")
    Debug.Print result
End Sub
user_84889130
Related