CodeItBetter Programming Another VB Programming Blog

'Arrays, Collections, Lists - How to sort data and remove duplicates.

Public Sub pRemoveDuplicatesFromStringArray(ByRef StrArray() As String)
  Dim lLower As Long, lUpper As Long
  Dim TmpArray() As String, Cur As Long
  Dim I As Long, J As Long
  'Check whether the array is empty
  If (Not StrArray) = True Then Exit Sub
  'Lowerbound
  lLower = LBound(StrArray)
  'Upperbound
  lUpper = UBound(StrArray)
  ReDim TmpArray(lLower To lUpper)
  'Set the 1st item
  Cur = lLower
  TmpArray(Cur) = StrArray(lLower)
  For I = lLower + 1 To lUpper
    'Compare all items
    For J = lLower To Cur
      If LenB(TmpArray(J)) = LenB(StrArray(I)) Then
      If InStrB(1, StrArray(I), TmpArray(J), vbBinaryCompare) = 1 Then Exit For
      End If
    Next J
    'check if the loop was exited: add new item to check buffer if not
    If J > Cur Then Cur = J: TmpArray(Cur) = StrArray(I)
  Next I
  'fix size
  ReDim Preserve TmpArray(lLower To Cur)
  'copy
  StrArray = TmpArray
End Sub