Excel: UniqueInCell UniqueInString

Takes a cell, separated by character returns. Then runs a unique algorithm to remove duplicates.

Public Function ArrayLen(arr As Variant) As Integer

    ArrayLen = UBound(arr) - LBound(arr) + 1

End Function

Function UniqueInCell(inputCell As Range, Optional Separator As String = vbLf)

  ' This function takes a cell and a delimiter and returns the same cell, but with all duplicates removed.

  'Dim inputArray() As String

  inputArray = Split(inputCell.Value, vbLf)

  For i = 0 To ArrayLen(inputArray) - 1

'    If inputArray(i) = "" Then Continue For ' Skip if blank

    For j = i + 1 To ArrayLen(inputArray) - 1

      If inputArray(i) = inputArray(j) Then inputArray(j) = "" ' Delete if same

    Next j

  Next i

  UniqueInCell = Join(inputArray, "Þ")

  UniqueInCell = Replace(UniqueInCell, "ÞÞ", "Þ") ' Need to iteratively replace multiple missing lines so repeat as necessary

  UniqueInCell = Replace(UniqueInCell, "ÞÞ", "Þ")

  UniqueInCell = Replace(UniqueInCell, "ÞÞ", "Þ")

  UniqueInCell = Replace(UniqueInCell, "ÞÞ", "Þ")

  UniqueInCell = Replace(UniqueInCell, "ÞÞ", "Þ")

  UniqueInCell = Replace(UniqueInCell, "ÞÞ", "Þ")

  UniqueInCell = Replace(UniqueInCell, "ÞÞ", "Þ")

  UniqueInCell = Replace(UniqueInCell, "ÞÞ", "Þ")

  UniqueInCell = Replace(UniqueInCell, "Þ", vbLf)

End Function

Takes a string, separated by character returns. Then runs a unique algorithm to remove duplicates.

Function UniqueInString(inputString As String, Optional Separator As String = vbLf)

  ' This function takes a string and a delimiter and returns the same cell, but with all duplicates removed.

  'Dim inputArray() As String

  inputArray = Split(inputString, vbLf)

  For I = 0 To ArrayLen(inputArray) - 1

'    If inputArray(i) = "" Then Continue For ' Skip if blank

    For J = I + 1 To ArrayLen(inputArray) - 1

      If inputArray(I) = inputArray(J) Then inputArray(J) = "" ' Delete if same

    Next J

  Next I

  UniqueInString = Join(inputArray, "Þ")

  UniqueInString = Replace(UniqueInString, "ÞÞ", "Þ") ' Need to iteratively replace multiple missing lines so repeat as necessary

  UniqueInString = Replace(UniqueInString, "ÞÞ", "Þ")

  UniqueInString = Replace(UniqueInString, "ÞÞ", "Þ")

  UniqueInString = Replace(UniqueInString, "ÞÞ", "Þ")

  UniqueInString = Replace(UniqueInString, "ÞÞ", "Þ")

  UniqueInString = Replace(UniqueInString, "ÞÞ", "Þ")

  UniqueInString = Replace(UniqueInString, "ÞÞ", "Þ")

  UniqueInString = Replace(UniqueInString, "ÞÞ", "Þ")

  UniqueInString = Replace(UniqueInString, "Þ", vbLf)

  If Right(UniqueInString, 1) = vbLf Then UniqueInString = Left(UniqueInString, Len(UniqueInString) - 1) ' remove last CR

  If Left(UniqueInString, 1) = vbLf Then UniqueInString = Right(UniqueInString, Len(UniqueInString) - 1) ' remove first CR

End Function