View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
anon anon is offline
external usenet poster
 
Posts: 77
Default DELETE DEBIT AND CREDIT FIGURES ROW BY MACRO

Here's some code to start you off;

Sub FINDANDDELETE()
Dim C, FINDC, C1, C2, FOUNDCELL, I, J, SRCHRNG
SRCHRNG = ActiveSheet.Range("H6:H17") 'change this range
I = 1
J = 500
For Each C In ActiveSheet.Range("H6:H17") 'change this range
C.Select
If Left(C.Value, 1) = "-" Then
FINDC = "+" & C.Value
Else
FINDC = "-" & C.Value
End If
C1 = C.Offset(0, 1).Value
C2 = C.Offset(0, 2).Value

With ActiveSheet.Cells
Set FOUNDCELL = ActiveSheet.Range("H6:H17").FIND(FINDC, ,
xlValues) 'change this range
End With
If Not FOUNDCELL Is Nothing Then
FOUNDCELL.Activate
If FOUNDCELL.Offset(0, 1).Value = C1 Then
If FOUNDCELL.Offset(0, 2).Value = C2 Then
FOUNDCELL.Value = "DUPLICATE" & I
C.Value = "DUPLICATE" & J
Else
'DO NOTHING
End If
End If
End If
I = I + 1
J = J + 1
Next C
Dim RNG As Range
For J = 6 To 17 'change this to be the row numbers of your range
Set RNG = ActiveSheet.Range("H" & J) 'change this to be the column
number of your range
RNG.Select
If Left(RNG.Value, 9) = "DUPLICATE" Then
RNG.EntireRow.Delete
J = J - 1
Else
End If
Next J
End Sub

Here's what you need to do;

Put the code in the worksheet object where your values are. Change the
ranges in the code - in this example I have used the range H6:H17 as
the first column in your table - in your example above it would be A1
to A12. I have marked in the code where you need to change the ranges
to suit your worksheet.

Run the code. It checks for a match and if it finds a match it marks
it as DUPLICATE. Then when it has found all of the DUPLICATES it
deletes these rows. I have tested it and it works perfectly for me.