View original (French)

Conditions for duplicates in the same cell

Solved
wuhrlinanthony Posted messages 57 Status Member -  
wuhrlinanthony Posted messages 57 Status Member -
Hello,

I'm trying to create a condition that would allow me to know which cell contains the same code twice. My code is 88.1SX8, and it is sometimes written twice in the same cell, and since I have 5000 rows, it's a bit long to do by hand ^^.
If a cell contains the same code twice, then the macro copies the entire row to a new sheet.
If you have any ideas for the code I can write, I'd be grateful.

Thank you in advance for your help.

Anthony

3 answers

  1.
    michel_m Posted messages 18903 Registration date   Status Contributor Last intervention   3 320
     
    Hello
    You should tell us more about the content of the cells

    88.1SX18 88.1SX18
    or
    88.1SX18blabla88.1SX18coucou
    or
    88.1SX18 blabla 88.1SX18 coucou
    or
    .....

    --
    Michel
    0
  2. Patrice33740 Posted messages 8400 Registration date   Status Member Last intervention   1 784
     
    Hello,

    Try this code: 
    Option Explicit Sub XXX() Const str As String = "88.1SX8" Dim src As Range Dim dst As Range Dim cel As Range Dim adr As String ' Source data range Set src = Worksheets(1).UsedRange ' Destination for copied rows Set dst = Worksheets(2).Cells.SpecialCells(xlCellTypeLastCell) If Not (dst.Address = "$A$1" And dst.Formula = "") Then ' First free destination cell Set dst = dst.EntireRow.Cells(1, 1).Offset(1) End If ' Find the first cell containing the value (str) Set cel = src.Find(str, , xlValues, xlPart) If Not cel Is Nothing Then ' memorize the address of the first cell (for loop exit) adr = cel.Address Do ' Check for duplicates ... If InStr(2, cel.Value, str) > 0 Then ' ... if present copy the row cel.EntireRow.Copy Destination:=dst ' next destination cell Set dst = dst.Offset(1) End If ' Find the next cell containing the value Set cel = src.Find(str, cel, xlValues, xlPart) If cel Is Nothing Then Exit Do If cel.Address = adr Then Exit Do Loop End If End Sub


    --
    Best regards
    Patrice
    0
  3. wuhrlinanthony Posted messages 57 Status Member
     
    Sorry for the late reply, I'm working abroad so there is a time difference.

    michel_m the codes are in this format: 88.1SX8#####,88.1SX8####
    There is no space between the characters.

    Patrice33740, your code works very well.

    Thank you.

    Anthony
    0