Maddening Dilemma - Compare each cell within column a to each cell
Okay, here's an amended macro in full, along the lines you have
suggested:
Sub Mark_duplicates_a()
'
' 04/10/2007, Pete Ashurst
' amended 17/10/2007
'
Dim my_top As Long
Dim my_bottom As Long
Dim colour As Integer
Application.ScreenUpdating = False
Columns("B:D").Select
Selection.Insert Shift:=xlToRight
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_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 = "Y"
Range("A" & my_bottom).Interior.ColorIndex = colour
Cells(my_bottom, 2).Value = "Y"
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: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
This inserts a new column B, so any other data on the sheet will be
moved to the right. Column B will contain "Y" wherever there is a
pairing - you could change this to "paired" or some-such by making the
obvious two changes mid-way in the macro.
The macro also applies colour banding for the ranges you suggested. It
should be fairly obvious how to introduce other ranges in the CASE
part of the macro (just keep the numbers in sequence), and you can
easily change colours if you don't like mine - here's some other
numbers you might like to play about with:
Red - 3, Aqua - 42, Orange - 46, Pink - 7, Tan - 40
Maybe marginally slower, but still less than 3 seconds on my test data
of nearly 2200 values.
Hope this helps.
Pete
On Oct 16, 3:30 pm, wrote:
Hey Pete,
Yes, absolutely, that would probably be useful. Thing is, management
is going to look at what ive done and decide what format they want it
in anyway. So i could group them by paired or unpaired and then they
could just go and undo it with some stupid autofilter, but i believe
it would look better and be easier to digest in such a sorted format.
In short: yes this would be useful !!!
As for the multicolor idea which i shot down, i can see how it would
be useful if say a seperate color was applied to ammount under 50k,
50k - 150k, 150k - 250k, 250 - 500k, 500k - 1M, etc. etc.
This way the colors could represent ranges of values.
Again, i do not need this functionality, but it would be interesting
if you wanted to implement it for others use.
Thanks again for keeping up with this, i hope your code can be put to
good use outside of my particular dilemma, because i think its such
useful functionality.
-Pogster
|