How to find duplicated items???

VN

Board Regular
Joined
Aug 19, 2003
Messages
83
I would like to find items that may duplicate in my data.

My data have dimension WxLxH or LxWxH or HxWxL so I have to do some thing to separate the item that may be duplicated item.

How can I do?

(may be make a format color for duplicated items)

Exsample as below;
Book1
CDEFG
17Original DataNew Data
1812x5x6 mm.12x5x6 mm.
193*2*5.5 mm3*2*5.5 mm
205mm x 77.3 x 8mm5mm x 77.3 x 8mm
213 mm x 2mm x 5.5 mmI would like it to be==>3 mm x 2mm x 5.5 mm
2212mm*5mm*6mm6mm*12mm*5mm
2312x5x6 mm.5x6 x12mm.
243*2*5.5 mm3*2*5.5 mm
255mm x 77.3 x 8mm5mm x 77.3 x 8mm
264 mm x 2mm x 5.5 mm4 mm x 2mm x 5.5 mm
2712mm*5mm*6mm12mm*5mm*6mm
2812x5x6 mm.12x5x6 mm.
293*2*5.5 mm3*5.5*2 mm
305mm x 77.3 x 8mm5mm x 77.3 x 8mm
315 mm x 2mm x 5.5 mm5 mm x 2mm x 5.5 mm
3212mm*5mm*6mm12mm*5mm*6mm
Sheet1
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

acw

MrExcel MVP
Joined
Feb 13, 2004
Messages
4,814
Hi

Easiest way I can see is to have all the measurements in the same format. The following UDF will generate a consistent approach. Put the code below into a general module associated with the sheet. Then

Code:
Function myfunc(xx)
  Dim myarr As Variant
  holder = xx
  holder = WorksheetFunction.Substitute(holder, "mm.", "")
  holder = WorksheetFunction.Substitute(holder, "mm", "")
  holder = WorksheetFunction.Substitute(holder, "*", ",")
  holder = WorksheetFunction.Substitute(holder, " ", "")
  holder = WorksheetFunction.Substitute(holder, "x", ",")
  myarr = Evaluate("={""" & WorksheetFunction.Substitute(holder, ",", """,""") & """}")
  For i = 1 To 3
    myarr(i) = Val(myarr(i))
  Next i
  For i = 1 To 2
    For j = 2 To 3
      If myarr(j) < myarr(i) Then
        tempp = myarr(i)
        myarr(i) = myarr(j)
        myarr(j) = tempp
      End If
    Next j
  Next i
  myfunc = myarr(1) & "x" & myarr(2) & "x" & myarr(3)
End Function


G18: =myfunc(C18)
H18: =IF(COUNTIF($G$18:G18,G18)>1,"DUPLICATE","")

Copy G18:H18 down as required.

HTH

Tony
 

VN

Board Regular
Joined
Aug 19, 2003
Messages
83
Thank you so much, Tony


I will try..


VN.. :biggrin:
 

VN

Board Regular
Joined
Aug 19, 2003
Messages
83
Oh... in fact, some items of my data is not dimension LxWxH that may be OD 23xID 22 or 220 VAC * 15 amp * 2Poll *55 etc..


How can i do??

Thanks.
 

acw

MrExcel MVP
Joined
Feb 13, 2004
Messages
4,814

ADVERTISEMENT

added different code method

Hi

1) Is the separator always going to be x or * (ie 2x2x2 or 2*2*2)

2) Is the size always going to be 3 dimensions or can it be of variable number of dimensions.


Tony

Code:
Function myfunc2(xx)
  Dim myarr As Variant
  Set fs = CreateObject("vbscript.regexp")
  Set fs = New RegExp
  
  
  fs.Global = True
  fs.Pattern = "[^0-9*x.]"
  holder = fs.Replace(xx, "")
  fs.Pattern = "[x*]"
  holder = fs.Replace(holder, ",")
  If Right(holder, 1) = "." Then holder = Left(holder, Len(holder) - 1)
  myarr = Evaluate("={""" & WorksheetFunction.Substitute(holder, ",", """,""") & """}")
  For i = 1 To UBound(myarr)
    myarr(i) = Val(myarr(i))
  Next i
  For i = 1 To UBound(myarr) - 1
    For j = 2 To UBound(myarr)
      If myarr(j) < myarr(i) Then
        tempp = myarr(i)
        myarr(i) = myarr(j)
        myarr(j) = tempp
      End If
    Next j
  Next i
  
  myfunc2 = myarr(1) & "x" & myarr(2) & "x" & myarr(3)
  
  
End Function
 

VN

Board Regular
Joined
Aug 19, 2003
Messages
83
Thank you ,Tony

I found ERROR at New RegExp that " User-defined type not defined".
 

acw

MrExcel MVP
Joined
Feb 13, 2004
Messages
4,814

ADVERTISEMENT

VN

Sorry, that line should be commented out or removed. Not required. Comes from the playing I was doing when I created this second method.

How about the questions I asked?


Tony
 

VN

Board Regular
Joined
Aug 19, 2003
Messages
83
For ERROR .. I can use it aleady. Thank you for your advice.
:biggrin:



Oh..Sorry for your question..
1. Yes .the separator always going to be * or x .

2. The size of dimensions is variable . Some Item is 2 ..some item 3 ..4…or 5 .
 

acw

MrExcel MVP
Joined
Feb 13, 2004
Messages
4,814
VN

Ok try

Code:
Function myfunc2(xx)
  Dim myarr As Variant
  Set fs = CreateObject("vbscript.regexp")
  
  
  fs.Global = True
  fs.Pattern = "[^0-9*x.]"
  holder = fs.Replace(xx, "")
  fs.Pattern = "[x*]"
  holder = fs.Replace(holder, ",")
  If Right(holder, 1) = "." Then holder = Left(holder, Len(holder) - 1)
  myarr = Evaluate("={""" & WorksheetFunction.Substitute(holder, ",", """,""") & """}")
  For i = 1 To UBound(myarr)
    myarr(i) = Val(myarr(i))
  Next i
  For i = 1 To UBound(myarr) - 1
    For j = i + 1 To UBound(myarr)
      If myarr(j) < myarr(i) Then
        tempp = myarr(i)
        myarr(i) = myarr(j)
        myarr(j) = tempp
      End If
    Next j
  Next i
  holder = ""
  For i = LBound(myarr) To UBound(myarr)
    holder = holder & myarr(i) & "x"
  Next i
  myfunc2 = Left(holder, Len(holder) - 1)
  
  
End Function



Tony
 

agihcam

Well-known Member
Joined
Jan 16, 2006
Messages
1,624
Hi -

I played around with this post and try if can be handled in one macro, I've come up with this codes;
Code:
Sub sample()
Dim i, ii As Long
Dim a
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 18 To Range("c" & Rows.Count).End(xlUp).Row
a = WorksheetFunction.Substitute(Cells(i, "c").Value, "mm.", "")
a = WorksheetFunction.Substitute(a, "mm", "")
a = WorksheetFunction.Substitute(a, "*", "x")
a = WorksheetFunction.Substitute(a, " ", "")
Cells(i, "g") = a
Next
Range("G18").Select
Range(Selection, Selection.End(xlDown)).Select
    Selection.TextToColumns Destination:=Range("G18"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=True, Comma:=True, Space:=True, Other:=True, OtherChar:= _
        "x", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1))
For ii = 18 To Range("g" & Rows.Count).End(xlUp).Row
Range(Cells(ii, "g"), Cells(ii, "g").End(xlToRight)).Select
    Selection.Sort Key1:=Cells(ii, "g"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Cells(ii, "g") = Cells(ii, "g") & "x" & Cells(ii, "h") & "x" & Cells(ii, "i") & "x" & Cells(ii, "j") & "x" & Cells(ii, "k") & "x" & Cells(ii, "l")
Next

i = Range("g" & Rows.Count).End(xlUp).Row
For ii = 18 To i
With Range("g18:g" & i)
Set c = .Find(Cells(ii, "g").Value, , , xlWhole)
If Not c Is Nothing And c.Address <> Cells(ii, "g").Address Then
firstAddress = c.Address
Do
c.Offset(, 6) = "Duplicate"
Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Next
Columns("h:l").Delete
i = Range("g" & Rows.Count).End(xlUp).Row
For ii = 18 To i
Cells(ii, "g") = Cells(ii, "c")
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
 

Forum statistics

Threads
1,141,019
Messages
5,703,776
Members
421,315
Latest member
awaisnazir139

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top