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.
|