CODEWITHSUNDEEP
excelvba
dfj328
dfj328

Reputation: 367

VBA displaying unique values in list

The following code filters unique values from a column. I am trying to display the output in the console, however, I get a "Subscript out of range" error. Is the array output from the function being passed into the variable correctly? If not, what is the issue? Any help is greatly appreciated.

Sub test1()

Dim Member() As String

Member = UnqiueMembers() 
Debug.Print Member(1)

End Sub

' get unique members from input data
Public Function UnqiueMembers() As String()

Const inputSheetName = "Input Data"
Const inputRange = "A3:A9"

Dim productWS As Worksheet
Dim uniqueList() As String 'dyanmic array
Dim productsList As Range
Dim anyProduct
Dim LC As Integer

ReDim uniqueList(1 To 1)
Set productWS = Worksheets(inputSheetName)
'Set outputWS = Worksheets(outputSheetName)
Set productsList = productWS.Range(inputRange)
Application.ScreenUpdating = False
For Each anyProduct In productsList
  If Not IsEmpty(anyProduct) Then
    If Trim(anyProduct) <> "" Then
      For LC = LBound(uniqueList) To UBound(uniqueList)
        If Trim(anyProduct) = uniqueList(LC) Then
          Exit For ' found match, exit
        End If
      Next
      If LC > UBound(uniqueList) Then
        'new item, add it
        uniqueList(UBound(uniqueList)) = Trim(anyProduct)
        'make room for another
        ReDim Preserve uniqueList(1 To UBound(uniqueList) + 1)
      End If
    End If
  End If
Next ' end anyProduct loop
If UBound(uniqueList) > 1 Then
  'remove empty element
  ReDim Preserve uniqueList(1 To UBound(uniqueList) - 1)
End If


UniqueMembers = uniqueList()

End Function

Upvotes: 0

Views: 126

Answers (2)

Tim Williams
Tim Williams

Reputation: 166316

Another Option Explicit candidate: function name is UnqiueMembers but you are returning a value by UniqueMembers = uniqueList()

Those two names are not the same ;-(

Upvotes: 1

chungtinhlakho
chungtinhlakho

Reputation: 930

If I'm reading this correctly. If all you want this a unique list. Use the Collection. and reject dups.

Dim t As Collection

Set t = New Collection
Dim t As Collection
Set t = New Collection

On Error Resume Next
t.Add "product name", "product name"
t.Add "product name", "product name"
t.Add "product name", "product name"
t.Add "product name", "product name"
t.Add "product name", "product name"
t.Add "product name", "product name"

On Error GoTo 0

the collection will not allow you to add any duplicate values. t will automatically become unique.

Upvotes: 0

Related Questions