Nearly forgot to post the revised code before going to bed - here it
is in full:

Sub Mark_duplicates_b()
'
' 04/10/2007, Pete Ashurst
' amended 17/10/07
' amended 22/10/07
'
Dim my_top As Long
Dim my_bottom As Long
Dim colour As Integer
Dim my_pair As Integer
Application.ScreenUpdating = False
Columns("B:D").Select
Selection.Insert Shift:=xlToRight
Selection.NumberFormat = "General"
Range("C1").Select
ActiveCell.Value = "1"
Range(Selection, Selection.End(xlDown)).Select
Selection.DataSeries Rowcol:=xlColumns, _
Type:=xlLinear, Date:=xlDay, _
Step:=1, Trend:=False
Columns("A:C").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, _
Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
my_pair = 1
my_top = 1
my_bottom = Cells(Rows.Count, "A").End(xlUp).Row
Do Until my_top = my_bottom
If Int(Cells(my_top, 1).Value * 10) / 10 =
Int(Abs(Cells(my_bottom, 1).Value) * 10) / 10 Then
Select Case Cells(my_top, 1).Value
Case Is < 50000
colour = 4 'Bright Green
Case Is < 150000
colour = 6 'Yellow
Case Is < 250000
colour = 8 'Turquoise
Case Is < 500000
colour = 39 'Lavendar
Case Else
colour = 15 'Grey
End Select
Range("A" & my_top).Interior.ColorIndex = colour
Cells(my_top, 2).Value = my_pair
Range("A" & my_bottom).Interior.ColorIndex = colour
Cells(my_bottom, 2).Value = my_pair
my_top = my_top + 1
my_bottom = my_bottom - 1
my_pair = my_pair + 1
ElseIf Cells(my_top, 1).Value Abs(Cells(my_bottom, 1).Value)
Then
my_top = my_top + 1
Else
my_bottom = my_bottom - 1
End If
Loop
Columns("A:C").Select
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Columns("C:D").Select
Selection.Delete Shift:=xlToLeft
Range("C1").Select
Application.ScreenUpdating = True
End Sub

I've left the colour banding in, as per the previous version. One
advantage of this approach is that you can see exactly how many pairs
have been found (523 in my test data of approx 2200 numbers). You
might want to change the line:

Cells(my_bottom, 2).Value = my_pair
to:
Cells(my_bottom, 2).Value = - my_pair

to show these as negative numbers.

By the way, the revised second link works okay for me, even though it
doesn't appear in full in the post and seems exactly the same as I had
posted previously - strange !!

Hope this helps.

Pete

On Oct 23, 12:14 am, Pete_UK wrote:
Here's the second link in full:

http://groups.google.com/group/micro...isc/browse_thr...

Hope this takes you there this time.

I'll post a revised macro later on - I had thought that the first pair
of numbers found would both be numbered 1, then 2 for the second pair,
3 for the 3rd pair etc. instead of just "Y".

Pete

On Oct 22, 4:27 pm, wrote:



Hi pete,

The numerical count is a good idea, would it assign a single value to
both numbers in each pair? Or a value to each number with the status
"paired"? Does this distinction make sense to you?

Either way, it is a good idea, i would like to see that code
modification, see if i can apply its functionality.

As for the links to aid in my second maddening dilemma, the first link
provides good explanations and some good solutions, though the second
link you posted is either incomplete or somehow wrong, the page does
not seem to exist.

Thanks for the info and yet another good code suggestion!

-pogster- Hide quoted text -

- Show quoted text -