There wasn't a lot of test data, so I made up my own. This seems to do
what you want, with a few extras - matching pairs of +ve and -ve
values are identified in column E when finished, and a colour is used
to identify those values which have been paired. Colours are allocated
in bands according to value. As you showed £ in your test data, values
are only checked down to pence.
If you want to delete the matching pairs, you can apply autofilter to
column E, selecting Non-blanks from the drop-down and then deleting
the visible records.
Be wary of spurious line breaks in the code which the newsgroup viewer
you are using might introduce.
Sub Mark_duplicates()
'
' 04/10/2007, Pete Ashurst
' amended 17/10/07
' amended 22/10/07
' amended 26/09/08
'
Dim my_top As Long
Dim my_bottom As Long
Dim colour As Integer
Dim my_pair As Integer
Application.ScreenUpdating = False
Columns("E:F").Select
Selection.Insert Shift:=xlToRight
Selection.NumberFormat = "General"
Range("E1").Select
ActiveCell.Value = "1"
Range(Selection, Selection.End(xlDown)).Select
Selection.DataSeries Rowcol:=xlColumns, _
Type:=xlLinear, Date:=xlDay, _
Step:=1, Trend:=False
Columns("A:E").Select
Selection.Sort Key1:=Range("D1"), Order1:=xlDescending, _
Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Range("D1").Select
my_pair = 1
my_top = 1
my_bottom = Cells(Rows.Count, "D").End(xlUp).Row
Do Until my_top = my_bottom
If Int(Cells(my_top, 4).Value * 100) / 100 =
Int(Abs(Cells(my_bottom, 4).Value) * 100) / 100 Then
Select Case Cells(my_top, 4).Value
Case Is < 50
colour = 4 'Bright Green
Case Is < 150
colour = 6 'Yellow
Case Is < 250
colour = 8 'Turquoise
Case Is < 500
colour = 39 'Lavendar
Case Else
colour = 15 'Grey
End Select
Range("D" & my_top).Interior.ColorIndex = colour
Cells(my_top, 6).Value = my_pair
Range("D" & my_bottom).Interior.ColorIndex = colour
Cells(my_bottom, 6).Value = -my_pair
my_top = my_top + 1
my_bottom = my_bottom - 1
my_pair = my_pair + 1
ElseIf Cells(my_top, 4).Value Abs(Cells(my_bottom, 4).Value)
Then
my_top = my_top + 1
Else
my_bottom = my_bottom - 1
End If
Loop
Columns("A:F").Select
Selection.Sort Key1:=Range("E1"), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
Range("E1").Select
Application.ScreenUpdating = True
End Sub
Hope this helps.
Pete
On Sep 25, 1:42*pm, Salman wrote:
Hi pete, Thank you very much. I will appreciate if you could please let me
have the solution to my problem on your return. Many thanks,
Salman
"Pete_UK" wrote:
I wrote a macro to do this for another poster about a year ago. It was
slightly different, in that he only had one column of +ve and -ve figures
(extracted from another file), and instead of deleting records he just
wanted matching records to be marked, so the data could be pasted back into
his other file. The macro evolved over several weeks.
It will need a bit of work to adapt it to your situation, and as I'm going
out soon it will have to be later on. If you want to look at the original
thread here's a link to it:
http://groups.google.com/group/micro...orksheet.funct...
Hope this helps.
Pete
"Salman" wrote in message
...
If I have following excel data. I want to net off column D by cancelling
+ves
& -ves. Please let me have a formula/macro which will only pick the last 3
lines in the following example (b/c 1st two nets off).
I actually have a 2000+ line report to analyse and look at the details
(name) for those which stays in once I have netted of the rest.
I want all the columns (ie A to D) to show.
A B C D
Name1 date1 No1 £100
Name2 date2 No2 -£100
Name3 date3 No3 £150
Name4 date4 No4 £300
Name5 date5 No5 -£100
Thanks for your help in advance.- Hide quoted text -
- Show quoted text -