Ihave a spreadsheet of over 2000 lines. It consists of Pat code,
description, color, UPC. I would like to search the data base for duplicat
Part codes and duplicat UPC's. Is there an eay way.

Thanks in advance,''Doug

Sub Dubletter() ' i område
Dim x, r As Double, c As Double, t, t2
Dim v(1000)
'x = Range("A1:J15")
x = Application.InputBox(prompt:="Select range, or write in box fx.
A1:B2000: ", Type:=8)
For c = 1 To UBound(x, 2)
For r = 1 To UBound(x, 1)
If x(r, c) < "" Then t = t + 1: v(t) = x(r, c)
Next
Next

For t = 1 To UBound(v)
If v(t) < "" Then
For t2 = t + 1 To UBound(v)
If v(t) = v(t2) Then
v(t2) = Empty
End If
Next
End If
Next
Application.InputBox(prompt:="Where do u want the List ? (click on cell): ",
Type:=8).Select
For t = 1 To UBound(v)
Cells(t, ActiveCell.Column) = v(t)
Next
On Error Resume Next
Selection.Columns.SpecialCells(xlCellTypeBlanks).R ows.Delete Shift:=xlUp
Range(ActiveCell, ActiveCell.End(xlDown)).Select
If MsgBox("Do u want to sort the list ?", vbYesNo, "No dublets") = vbYes Then
Selection.Sort Key1:=Range(ActiveCell.Address), Order1:=xlAscending
End If
ActiveCell.Select
End Sub

In this example the data is in the range A1:D5.

Sub ShowDups()

Dim i As Long
Dim LR As Long
Dim arrRange
Dim collPatCode As Collection
Dim collUPC As Collection

Set collPatCode = New Collection
Set collUPC = New Collection

arrRange = Range(Cells(2, 1), Cells(5, 4))
LR = UBound(arrRange)

On Error Resume Next

For i = 1 To LR
collPatCode.Add arrRange(i, 1), CStr(arrRange(i, 1))
If Err.Number < 0 Then
Cells(i + 1, 1).Interior.ColorIndex = 6
Err.Clear
End If
Next

For i = 1 To LR
collUPC.Add arrRange(i, 4), CStr(arrRange(i, 4))
If Err.Number < 0 Then
Cells(i + 1, 4).Interior.ColorIndex = 7
Err.Clear
End If
Next

End Sub

It will colour the cells, but you can easily adapt it to make it do
something else with the duplicate items.


RBS


"flirodr" wrote in message
...
Ihave a spreadsheet of over 2000 lines. It consists of Pat code,
description, color, UPC. I would like to search the data base for
duplicat
Part codes and duplicat UPC's. Is there an eay way.

Thanks in advance,''Doug

flirodr wrote:
*Ihave a spreadsheet of over 2000 lines. It consists of Pat code,
description, color, UPC. I would like to search the data base for
duplicat
Part codes and duplicat UPC's. Is there an eay way.

Thanks in advance,''Doug *



--
davidmy
------------------------------------------------------------------------
Posted via http://www.mcse.ms
------------------------------------------------------------------------
View this thread: http://www.mcse.ms/message2504508.html