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) + 1End FunctionFunction 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 FunctionTakes 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 CREnd Function