View Single Post
  #30  
Old October 7th, 2007, 01:08 AM posted to microsoft.public.excel.worksheet.functions
Pete_UK
external usenet poster
 
Posts: 8,780
Default Maddening Dilemma - Compare each cell within column a to each cell

Hi Pogster,

I see you are still following this thread. Here's a macro I put
together a few days ago based on the algorithm I gave you last
weekend. It should be quite quick, even with large amounts of data. It
uses column B, so if you have any data in there you should insert a
new column B at the beginning of the macro (it gets deleted at the
end):

Sub Mark_duplicates()
'
' 04/10/2007, Pete Ashurst
'
Dim my_top As Long
Dim my_bottom As Long
Application.ScreenUpdating = False
Range("B1").Select
ActiveCell.Value = "1"
Range(Selection, Selection.End(xlDown)).Select
Selection.DataSeries Rowcol:=xlColumns, _
Type:=xlLinear, Date:=xlDay, _
Step:=1, Trend:=False
Columns("A:B").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
my_top = 1
my_bottom = Cells(Rows.Count, "A").End(xlUp).Row
Do Until my_top = my_bottom
If Cells(my_top, 1).Value = Abs(Cells(my_bottom, 1).Value)
Then
Range("A" & my_top).Interior.ColorIndex = 4
Range("A" & my_bottom).Interior.ColorIndex = 4
my_top = my_top + 1
my_bottom = my_bottom - 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:B").Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Range("B1").Select
Application.ScreenUpdating = True
End Sub

Beware of spurious line-wraps on some of the long lines.

Hope this helps.

Pete

On Oct 6, 4:39 pm, wrote:
Max,

Your solution works wonders, and achieves close to a perfect result
every time. What change to the formula in column C would i need to
make to round it off to the tenths place, instead of 2 decimal
places. I am working with foreign currencies and conversions to USD
usually throw it off a little bit.

Now i just need to work out a way to convert the process into a macro
since its essentially exactly the same for every spreadsheet i do.

I cant thank you and everyone else who has posted on this forum
enough, you guys n gals rock. Thanks so much!

-Pogster