Solved: remove the repeated words/numbers in a cell

[rafi_07max]

I have a set of data in column A.

For e.g. the content in cell A1 is

1, 2, 4, DA6, 1, DA6, 21, 1

We can see that “1” and “DA6” has been repeated more than once. So what I what to do is to remove all the extra words/numbers.

After running the macro successfully the content in cell A1 should be

1, 2, 4, DA6, 21

I want to do this for the entire column A.

[vishwakarma]

Hi,

try this...

Function Uniques(inputString As String) As String
Const delimiter As String = ","
Dim inArray() As String
Dim xVal As Variant
inArray = Split(inputString, delimiter)
Uniques = delimiter
For Each xVal In inArray
If InStr(Uniques, delimiter & Trim(xVal) & delimiter) = 0 Then _
Uniques = Uniques & Trim(xVal) & delimiter
Next xVal
Rem remove this line To leave a leading delimiter
Uniques = Right(Uniques, Len(Uniques) - 1)
End Function

[Bob Phillips]

Public Sub ProcessData()
Dim vecUniques As Variant
Dim vecWords As Variant
Dim numWords As Long
Dim Lastrow As Long
Dim nextItem As Long
Dim i As Long, j As Long

With ActiveSheet

Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To Lastrow

vecWords = Split(.Cells(i, "A").Value, ",")
numWords = UBound(vecWords) - LBound(vecWords) + 1
ReDim vecUniques(1 To numWords)
For j = 1 To numWords

If IsError(Application.Match(Trim(vecWords(j - 1)), vecUniques, 0)) Then

nextItem = nextItem + 1
vecUniques(nextItem) = Trim(vecWords(j - 1))
End If
Next j

ReDim Preserve vecUniques(1 To nextItem)
.Cells(i, "A").Value = Join(vecUniques, ", ")
Next i
End With
End Sub

[rafi_07max]

Thanks manoj for your help. But how to call your function?

Thanks xld for your help. It works. But it only works for cell A1. If there is content in other cells in column A, then the program will get error.
I have attached a sample worksheet with your codes, and it also contains some data in sheet 1.
5205

[macropod]

Hi Rafi,

Here's and alternative Function:
Function Uniques(InputString As String, Delimiter As String) As String
Dim StrArray() As String, i As Integer, j As Integer
StrArray = Split(InputString, Delimiter)
For i = 0 To UBound(StrArray) - 1
If StrArray(i) <> vbNullString Then
For j = i + 1 To UBound(StrArray)
If StrArray(i) = StrArray(j) Then StrArray(j) = vbNullString
Next
For j = i + 1 To UBound(StrArray) - 1
If StrArray(j) = vbNullString Then
StrArray(j) = StrArray(j + 1)
StrArray(j + 1) = vbNullString
End If
Next
End If
Next
j = 0
For i = UBound(StrArray) To 1 Step -1
If StrArray(i) = vbNullString Then j = j + 1
Next
ReDim Preserve StrArray(UBound(StrArray) - j)
Uniques = Join(StrArray, Delimiter)
End Function
If your string is in A1, you can use the following formula in another cell to parse it:
=Uniques(A1, ", ")

Unlike Majoj's function, mine allows you to vary the separators.

If you want to change the contents of a range of cells instead of outputting the results in another range, you can call the function with a macro like:
Sub UniqueVals()
Dim oCel As Range
For Each oCel In Selection
oCel.Value = Uniques(oCel.Value, ", ")
Next
End Sub

[vishwakarma]

Hi Rafi,

if your value is in cell A1, then just type the below formula in the next cell :-

=Uniques(cell reference)...

But I would suggest you to use Paul's function as it does allows you to vary the separators.


Cheers,

[rafi_07max]

Thanks Paul Edstein for your time and help. Your codes works.

Thanks Manoj for your help and advice.