Function combineuni(rng As Range) As String 'GB
Dim cel As Range
Dim uniqueWords As Collection
Set uniqueWords = New Collection
For Each cel In rng
Dim words() As String
words = Split(cel.Value, ",")
Dim word As Variant
For Each word In words
On Error Resume Next
uniqueWords.Add Trim(word), CStr(Trim(word))
On Error GoTo 0
Next word
Next cel
combineuni = Join(CollectionToArray(uniqueWords), ",")
End Function
Function CollectionToArray(col As Collection) As Variant()
Dim arr() As Variant
ReDim arr(1 To col.Count)
Dim i As Integer
For i = 1 To col.Count
arr(i) = col.Item(i)
Next i
CollectionToArray = arr
End Function
Function NoDupes(r As Range) As String
Dim itm As Variant
Dim c As Range
For Each c In r
For Each itm In Split(c.Value, ",")
If InStr(1, NoDupes & ",", "," & itm & ",") = 0 Then NoDupes = NoDupes & "," & itm
Next itm
Next c
NoDupes = Mid(NoDupes, 2)
End Function
sean1541.xlsm | |||
---|---|---|---|
B | |||
1 | G,E | ||
2 | S,MK,SP | ||
3 | CY,SP | ||
4 | G,F | ||
5 | G,E,S,MK,SP,CY,F | ||
Sheet1 |
Cell Formulas | ||
---|---|---|
Range | Formula | |
B5 | B5 | =NoDupes(B1:B4) |
Works perfect thanks a millionExcel 2016 means you don't have some of the more recent functions that would make this easier so I think that you would need a vba solution. Also, with MacOS, you also don't have access to some vba capabilities that might normally be used for a task like this.
However, I think that you could employ a fairly simple user-defined function like this. To implement ..
1. Right click the sheet name tab and choose "View Code".
2. In the Visual Basic window use the menu to Insert|Module
3. Copy and Paste the code below (you can use the icon at the top right of the code pane below) into the main right hand pane that opens at step 2.
4. Close the Visual Basic window.
5. Enter the formula as shown in the screen shot below.
6. Your workbook will need to be saved as a macro-enabled workbook (*.xlsm)
VBA Code:Function NoDupes(r As Range) As String Dim itm As Variant Dim c As Range For Each c In r For Each itm In Split(c.Value, ",") If InStr(1, NoDupes & ",", "," & itm & ",") = 0 Then NoDupes = NoDupes & "," & itm Next itm Next c NoDupes = Mid(NoDupes, 2) End Function
sean1541.xlsm
B 1 G,E 2 S,MK,SP 3 CY,SP 4 G,F 5 G,E,S,MK,SP,CY,F Sheet1
Cell Formulas Range Formula B5 B5 =NoDupes(B1:B4)