Removing duplicates WITHIN cell

[mawheele]

I want to run a loop on a column that checks each row for duplicates WITHIN each cell and eliminates those duplicates. Thus, I would want:

Column A
1, 1, 2, 3
2, 2, 3
4, 5 , 6, 6

to become

Column A
1, 2, 3
2, 3
4, 5, 6

Any suggestions? Is there a command that counts the number of characters up until a certain character? Then I could say IF characters until "," equal characters after "," THEN delete characters after ","

Much appreciation to anyone with thoughts!

 

[almagg]

my guess would be to first use the 'text to data' and split the contents into separate cells. here is whatt i got recording a macro:

Selection.TextToColumns Destination:=Range("F4"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= True

F4 just happened to be the upper left corner of where I had the data.

now looking at the data you posted, it looks like the first number is what may be repeated i.e., will there be cells like:

4, 5, 5, 6 ?

also can the first number be repeated at any time e.g.,

4, 5, 4, 6 ?

these are all important questions when determining how to set up the loop.

 

[mawheele]

text to columns

I was thinking the same thing with text to columns, but I wanted to keep it efficient. In the case that I do split up the entries into different columns, the repeated items will be consecutive. In addition, they aren't single numbers...that was my example. The true content of one of the cells would be similar to:

MC-31103, MC31103, MC-31104, MC-31104

Which I would want to yield:

MC-31103, MC-31104

So, in reference to your question, repeated entries will be adjacent. Thanks

 

[Scott Huish]

Since the duplicates will be next to each other, perhaps:

This has Column A being the original entries and puts the new ones in Column B, change as necessary:

Sub test()
Dim c As Range, t, u As Long, temp
For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
    t = Split(c, ",")
    For u = 0 To UBound(t) - 1
        If Trim(t(u)) = Trim(t(u + 1)) Then t(u + 1) = "`"
    Next u
    temp = Application.WorksheetFunction.Trim(Join(t, ", ")) & ","
    temp = Application.WorksheetFunction.Trim(Replace(temp, "`,", ""))
    c.Offset(, 1) = Left(temp, Len(temp) - 1)
Next
End Sub

 

[Scott Huish]

Try this:

Sub test()
Dim c As Range, s, t, temp
For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
    t = Split(c, ",")
    For Each s In t
        If InStr(Trim(temp), Trim(s)) = 0 Then temp = temp & s & ", "
    Next
    temp = Application.WorksheetFunction.Trim(temp)
    c.Offset(, 1) = Left(temp, Len(temp) - 1)
    temp = ""
Next
End Sub