Closed Thread
Results 1 to 17 of 17

Remove duplicates within a cell

  1. #1
    Registered User
    Join Date
    12-29-2006
    Posts
    4

    Remove duplicates within a cell

    Hi,

    Below is a typical example of the contents of one of my cells (of which I have around 500 cells):
    263,330,335,430,431,435,640,700,748,750,752,800,807,901,916,917,937,944,954,953,962,266,2038,2054,2056,2057,2058,357, 591, 800, 802, 748, 423, 801, 570, 955, 747, 940, 800, 748, 918, 800,730,579,728,307,310,577,717,939,958,713,
    332,613,640,661,690, 800, 613, 332, 434, 575, 593, 904, 943, 648, 946, 947, 2079
    I'd like to remove duplicate entries from this cell (per cell) e.g. "800" appears several times. We can distinguish between each entry by the comma - but how can I get Excel to look inside one specific cell at text and remove these?

    Adam

  2. #2
    Valued Forum Contributor mudraker's Avatar
    Join Date
    11-10-2003
    Location
    Melbourne, Australia
    Posts
    3,983
    Adam

    Try this macro - I beleive it does what you want

    I runs from A1 to last used row in Column A - skipping over blank cells

    It replaces contents of the cell with the duplicates removed so - Try it on a backup copy of your data

    ,800,
    is treated as being differnet to , 800,


    Sub findCellDuplicates()
    Dim Rng As Range

    Dim bAdd As Boolean

    Dim iLastRow As Integer
    Dim iPos(1 To 3) As Integer
    Dim iLen As Integer
    Dim iArrSearch As Integer
    Dim iArrCnt As Integer

    Dim sCellTxt As String
    Dim sFind As String
    Dim sArr() As String

    iLastRow = Cells(Rows.Count, "a").End(xlUp).Row

    For Each Rng In Range("a1:a" & iLastRow)
    iPos(1) = 1
    If Rng.Value <> "" Then
    sCellTxt$ = Rng.Value
    iArrCnt = 0
    ReDim sArr(0)
    'build unique value array
    Do
    iPos(2) = InStr(iPos(1), sCellTxt, ",")
    iPos(3) = InStr(iPos(2) + 1, sCellTxt, ",")
    If iPos(3) = 0 Then
    Exit Do
    End If
    sFind$ = Mid(sCellTxt, iPos(1), iPos(2) - iPos(1))
    bAdd = True
    If iArrCnt > 0 Then
    'test if value already added to array
    For iArrSearch = 0 To iArrCnt Step 1
    If sArr(iArrSearch) = sFind Then
    bAdd = False
    Exit For
    End If
    Next iArrSearch
    End If
    If bAdd = True Then
    'add value to array
    If sArr(iArrCnt) <> "" Then
    iArrCnt = iArrCnt + 1
    End If
    ReDim Preserve sArr(iArrCnt)
    sArr(iArrCnt) = sFind
    End If
    iPos(1) = iPos(2) + 1
    Loop
    'rebuild cell text
    sCellTxt$ = sArr(0)
    For iArrSearch = 1 To iArrCnt Step 1
    sCellTxt$ = sCellTxt & "," & sArr(iArrSearch)
    Next iArrSearch
    Rng.Offset(0, 1).Value = sCellTxt
    End If
    Next Rng
    Last edited by mudraker; 12-29-2006 at 08:03 AM.

  3. #3
    Registered User
    Join Date
    12-29-2006
    Posts
    4
    Your code looks good, and is closer than ive got but it seems to keep ommitting the end of my values. It does this for any length string.

    Eg. original:
    800, 800, 269, 151, 999, 272

    After macro:
    800, 800, 269, 151

    It seems to have removed 999 and 272, but also has not removed the duplicate 800.

    Any ideas? and thanks again.

  4. #4
    Valued Forum Contributor mudraker's Avatar
    Join Date
    11-10-2003
    Location
    Melbourne, Australia
    Posts
    3,983
    Adam

    Try this version- I had an attack of muddy logic in my code

    As for the 800, 800 still bing listed as I tried to say in my 1st reply an entry of ,800, is considered different to an entry of , 800,

    The macro considers all characters beween the commas. You have entries equal to 800 and different entries equal to space 800

    If you want the macro to ignore the spaces before and after the comma then use the 2nd version of this macro.

    If you post a reply or a question can you please mention which version you are refering to.


    Version 1
    Sub findCellDuplicates()
    Dim Rng As Range

    Dim bAdd As Boolean

    Dim iLastRow As Integer
    Dim iPos(1 To 2) As Integer
    Dim iLen As Integer
    Dim iArrSearch As Integer
    Dim iArrCnt As Integer

    Dim sCellTxt As String
    Dim sFind As String
    Dim sArr() As String

    iLastRow = Cells(Rows.Count, "a").End(xlUp).Row

    For Each Rng In Range("a1:a" & iLastRow)
    iPos(1) = 1
    If Rng.Value <> "" Then
    sCellTxt$ = Rng.Value
    iArrCnt = 0
    ReDim sArr(0)
    'build unique value array
    Do
    iPos(2) = InStr(iPos(1), sCellTxt, ",")
    If iPos(2) = 0 Then
    sFind$ = Mid(sCellTxt, iPos(1))
    iPos(1) = 0
    Else
    sFind$ = Mid(sCellTxt, iPos(1), iPos(2) - iPos(1))
    End If
    bAdd = True
    If iArrCnt > 0 Then
    'test if value already added to array
    For iArrSearch = 0 To iArrCnt Step 1
    If sArr(iArrSearch) = sFind Then
    bAdd = False
    Exit For
    End If
    Next iArrSearch
    End If
    If bAdd = True Then
    'add value to array
    If sArr(iArrCnt) <> "" Then
    iArrCnt = iArrCnt + 1
    End If
    ReDim Preserve sArr(iArrCnt)
    sArr(iArrCnt) = sFind
    End If
    iPos(1) = iPos(2) + 1
    Loop While iPos(2) > 1
    'rebuild cell text
    sCellTxt$ = sArr(0)
    For iArrSearch = 1 To iArrCnt Step 1
    sCellTxt$ = sCellTxt & "," & sArr(iArrSearch)
    Next iArrSearch
    Rng.Offset(0, 1).Value = sCellTxt
    End If
    Next Rng
    End Sub

    version 2
    Sub findCellDuplicates()
    Dim Rng As Range

    Dim bAdd As Boolean

    Dim iLastRow As Integer
    Dim iPos(1 To 2) As Integer
    Dim iLen As Integer
    Dim iArrSearch As Integer
    Dim iArrCnt As Integer

    Dim sCellTxt As String
    Dim sFind As String
    Dim sArr() As String

    iLastRow = Cells(Rows.Count, "a").End(xlUp).Row

    For Each Rng In Range("a1:a" & iLastRow)
    iPos(1) = 1
    If Rng.Value <> "" Then
    sCellTxt$ = Rng.Value
    iArrCnt = 0
    ReDim sArr(0)
    'build unique value array
    Do
    iPos(2) = InStr(iPos(1), sCellTxt, ",")
    If iPos(2) = 0 Then
    sFind$ = Trim(Mid(sCellTxt, iPos(1)))
    iPos(1) = 0
    Else
    sFind$ = Trim(Mid(sCellTxt, iPos(1), iPos(2) - iPos(1)))
    End If
    bAdd = True
    If iArrCnt > 0 Then
    'test if value already added to array
    For iArrSearch = 0 To iArrCnt Step 1
    If sArr(iArrSearch) = sFind Then
    bAdd = False
    Exit For
    End If
    Next iArrSearch
    End If
    If bAdd = True Then
    'add value to array
    If sArr(iArrCnt) <> "" Then
    iArrCnt = iArrCnt + 1
    End If
    ReDim Preserve sArr(iArrCnt)
    sArr(iArrCnt) = sFind
    End If
    iPos(1) = iPos(2) + 1
    Loop While iPos(2) > 1
    'rebuild cell text
    sCellTxt$ = sArr(0)
    For iArrSearch = 1 To iArrCnt Step 1
    sCellTxt$ = sCellTxt & "," & sArr(iArrSearch)
    Next iArrSearch
    'force excel to treat what it cosiders large numbers as text
    Rng.Offset(0, 1).NumberFormat = "@"
    Rng.Offset(0, 1).Value = sCellTxt
    End If
    Next Rng
    End Sub

  5. #5
    Registered User
    Join Date
    12-29-2006
    Posts
    4
    Thanks very much for your help.

    Your version 1 does exactly as you say, great.

    However i'd prefer to use version 2, except it returns me a "Type Mismatch" error and I cannot figure out where it's coming from. Any ideas?

    Adam

  6. #6
    Valued Forum Contributor mudraker's Avatar
    Join Date
    11-10-2003
    Location
    Melbourne, Australia
    Posts
    3,983
    Can you post a workbook with your data in it that is causing the problem. My code seemed to work ok on the small sample of data that you originally supplied.

  7. #7
    Registered User
    Join Date
    12-29-2006
    Posts
    4
    Solved. Issue was having both macros in same worksheet.

    Thank you very very much

  8. #8
    Valued Forum Contributor mudraker's Avatar
    Join Date
    11-10-2003
    Location
    Melbourne, Australia
    Posts
    3,983
    Glad to hear you resolved the problem.

    Sounds like I had better use different macro names when I post multiple versions

  9. #9
    Registered User
    Join Date
    01-10-2007
    Posts
    5
    Hello,

    What if the separator is not ",", but something else ? ( for example ":" or ";" ). How would you change the code to work in that case ?

    Thank you !

  10. #10
    Valued Forum Contributor mudraker's Avatar
    Join Date
    11-10-2003
    Location
    Melbourne, Australia
    Posts
    3,983
    Adam


    If all you data is seperated by the same charator you will need to make a change in this line of code of the macro

    iPos(2) = InStr(iPos(1), sCellTxt, ",")

    Change the commar to what ever your seperator charactor is

    example from "," to ";"

    If you are using mixed charactors to seperate your numbers then the 1st part of the macro will need to be re-written

  11. #11
    Registered User
    Join Date
    01-10-2007
    Posts
    5
    Hi,

    Thanks for the reply. I had some troubles running it, but in the end it turned out ok.

    By the way, I think there is a bug in the current code, in the sense that if you have something like 800; 800; 12; 12; 13; 13; 14; you will end up with 800; 800; 12; 13; 14; In other words, the first duplicate is skipped, due to the way iArrCnt is incremented.

    I think if you change "If iArrCnt > 0 Then" to "If iArrCnt >= 0 Then", then it seems to work correctly.

    I do have another question: I have changed "Rng.Offset(0, 1).Value = sCellTxt" to "Rng.Value = sCellTxt", so that each cell in overwritten with the one resulting after the processing. How would I make this script run on the entire spreadsheet now, and not just on one column ?

    Many thanks !

    M.

  12. #12
    Valued Forum Contributor mudraker's Avatar
    Join Date
    11-10-2003
    Location
    Melbourne, Australia
    Posts
    3,983
    mihai_gros are you also forzaboro or just trying to use what I wrote for forzaboro

    The reason I am asking is that forzaboro reply on the 01-02-2007 08:18 AM gave the impresion that he was happy with what version 1 does.

    I suggest you re-read my reply on 12-30-2006 05:26 AM which explains why their are 2 800's listed.

    When the macro 1st runs iArrCnt = 0 until an entry is made into the array.
    Once an entry has been made it increase iArrCnt by 1

    The macro use the command If iArrCnt > 0 to check if any entries have been added to the array. With iarray = 0 there is no entries in the array and no need to search the array to try and match entries.

    As for the use of the offset command when writing to the sheet there was no indication as what was required so I placed it into another column in the same row - this also helps with checking results againsy initial cell entry.

    If it is required to run over other columns besides column A then this can be added to the code. I just need to know what columns.

  13. #13
    Registered User
    Join Date
    01-10-2007
    Posts
    5
    Hi mudraker !

    Thank you for your reply. No, I am not forzaboro, I am just using the scripts you posted for him.

    I did read your comment about 12-30-2006 05:26 AM. That it is not the case for me, since there are no spaces between my values.

    My understanding of this part of the code:

    If bAdd = True Then
    'add value to array
    If sArr(iArrCnt) <> "" Then
    iArrCnt = iArrCnt + 1
    End If
    ReDim Preserve sArr(iArrCnt)
    sArr(iArrCnt) = sFind

    is that you increment the counter if there is some value at the current position in the array, and then you add the new value. So, after the first run you have:

    sArr(0) = 800
    iArrCnt = 0

    After the second run, you have:
    sArr(1) = 800
    iArrCnt = 1

    Although there are two identical values in sArr now.

    The reason it is like this is because in the first cycle you add a value to sArr(0), but the counter iArrCnt is not increased until the next cycle. So what happens is that when "If iArrCnt > 0 Then" gets executed, there is no comparison done with the first value in the array, because although sArr(0) is there, iArrCnt = 0.

    THis is why I was saying having "If iArrCnt >= 0 Then" instead solves this issue that I encountered.

    I am sorry if I cannot explain myself very well, english is not my mothertongue. But if you run it step-by-step with some watches enabled you can see what I mean.

    Thank you.

    M.

  14. #14
    Valued Forum Contributor mudraker's Avatar
    Join Date
    11-10-2003
    Location
    Melbourne, Australia
    Posts
    3,983
    mihai

    You are correct there is an error in my code and you explained it very well.

    The command If iArrCnt > 0 is not the cause of the error but changing it to If iArrCnt >= 0 over came the error

    The error is actually in this part of the code were iArrCnt should have been increased on the 1st loop but was not

    Please Login or Register  to view this content.
    If you change the above code to the following code it should fix the problem

    Please Login or Register  to view this content.

  15. #15
    Registered User
    Join Date
    10-26-2010
    Location
    london england
    MS-Off Ver
    Excel 2004 for Mac
    Posts
    1

    Re: Remove duplicates within a cell

    Hi, I know this is an old thread but I am trying to use this macro on a MAC EXCEL 2004 Spreadsheet. When I hit the DEbug it says ; End if without Block if. ????? ( the last section 13 lines from end of the code .
    iArrCnt = iArrCnt + 1
    End If
    ReDim Preserve sArr(iArrCnt)
    sArr(iArrCnt) = sFind
    End If
    [/CODE]

    If you change the above code to the following code it should fix the problem

    Please Login or Register  to view this content.
    [/QUOTE]

  16. #16
    Registered User
    Join Date
    08-29-2011
    Location
    Laconia, NH
    MS-Off Ver
    Excel 2003
    Posts
    1

    Re: Remove duplicates within a cell

    Hello. This is almost exactly what I was looking for! It does not work for me though. I believe its because of my data. What I have is mostly two or three charectors with letters and numbers in the same cell (besides the ," ").
    Looks like this. E1, E1, E1, F15, F15, G7,
    What I am having trouble with getting is E1, F15, G7

    Thanks, Scott

  17. #17
    Forum Expert
    Join Date
    12-23-2006
    Location
    germany
    MS-Off Ver
    XL2003 / 2007 / 2010
    Posts
    6,325

    Re: Remove duplicates within a cell

    Your post does not comply with Rule 2 of our Forum RULES. Don't post a question in the thread of another member -- start your own thread. If you feel it's particularly relevant, provide a link to the other thread.

Closed Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1