Hi All,
I am trying to create a unique list from cells that are formated like this:
<-letter->
1 A;B;C
2 A;J;D
3 D
4 D;E
5 C;H
Desired Result
6 A;B;C;D;E;H;J
I would like to have a function where I define the range and type of delimiter then the result is a unique list that is organized alphabetically with the same delimiter.
Is there a way to do this with a VBA function?
------
Thanks in advance for the help
Re: Unique Values from multiple cells with delimiter into one cell
you can try this code
Function str_split(myrange As Range, sep) As String
On Error Resume Next
Dim myarray()
For Each cell In myrange
For i = 1 To Len(cell.Value)
If Mid(cell.Value, i, 1) <> sep Then
If x = 0 Then
x = x + 1
ReDim Preserve myarray(1)
myarray(1) = Mid(cell.Value, i, 1)
End If
If x >= 1 Then
If WorksheetFunction.Match(Mid(cell.Value, i, 1), myarray(), 0) = False Then
x = x + 1
ReDim Preserve myarray(x)
myarray(x) = Mid(cell.Value, i, 1)
End If
End If
End If
Next i
Next cell
For i = 1 To x
If i = 1 Then
mystr = myarray(1)
Else
mystr = mystr & sep & myarray(i)
End If
Next i
str_split = mystr
End FunctionRe: Unique Values from multiple cells with delimiter into one cell
UDF
Use in cell like
=Uniq(A1:A5,";")
Function Uniq(rng As Range, delim As String) As String
Dim r As Range, e
With CreateObject("System.Collections.ArrayList")
For Each r In rng
For Each e In Split(r.Value, delim)
If Not .Contains(Trim$(e)) Then .Add Trim$(e)
Next
Next
.Sort
Uniq = Join(.ToArray, delim)
End With
End FunctionRe: Unique Values from multiple cells with delimiter into one cell
Thanks Jindon!
Your code works great!
Don’t have an account yet? Register yourself now and be a part of our community!