DELETE DEBIT AND CREDIT FIGURES ROW BY MACRO
Hi,
1 & 2. Both I & J are just there to mark the cells Duplicate 1,
Duplicate 2, Duplicate 500 etc before they are deleted. They are not
column letters.
3. To change this you need to replace the one line with these lines;
Dim toend As Long
toend = Range("H" & Rows.Count).End(xlUp).Row
For Each C In ActiveSheet.Range("H6:H" & toend)
4. C1 = C.Offset(0, 1).Value
This is checking the column one row to the right of H and storing
the value (column I)
5. C2 = C.Offset(0, 2).Value
This is checking the column two rows to the right of H and storing the
value (column J)
6. For J = 6 To 17
If you have added in the code described above in step 3 just change
this line to
For J = 6 to toend
So your code will look like this (I have added explanations)
Sub FINDANDDELETE()
Dim C, FINDC, C1, C2, FOUNDCELL, I, J, SRCHRNG
SRCHRNG = ActiveSheet.Range("H6:H17") 'change this range
I = 1
J = 500
Dim toend As Long
toend = Range("H" & Rows.Count).End(xlUp).Row 'find the last row
in column H and store it as toend
For Each C In ActiveSheet.Range("H6:H" & toend) ' for each cell (C) in
H6 to the last used row in column H
C.Select 'select the cell
If Left(C.Value, 1) = "-" Then 'check if the value of the cell is a
minus number
FINDC = "+" & C.Value 'if it is a minus number set FINDC (ie. the
value to search for) as a poitive number
Else 'if it is not a minus number
FINDC = "-" & C.Value 'set FINDC (ie. the value to search for) as a
minus number
End If
C1 = C.Offset(0, 1).Value 'set C1 as the value of the cell in the same
row in column I
C2 = C.Offset(0, 2).Value 'set C1 as the value of the cell in the same
row in column J
With ActiveSheet.Cells
Set FOUNDCELL = ActiveSheet.Range("H6:H" & toend).FIND(FINDC, ,
xlValues) 'FOUNDCELL is what we're looking for
End With
If Not FOUNDCELL Is Nothing Then 'if the matching value is cound
in column H
FOUNDCELL.Activate 'activate the cell where it is found
If FOUNDCELL.Offset(0, 1).Value = C1 Then 'check the cell in
column I matched the column I on the row we are searching from
If FOUNDCELL.Offset(0, 2).Value = C2 Then 'check the cell in
column J matched the column I on the row we are searching from
FOUNDCELL.Value = "DUPLICATE" & I 'if all 3 cells match set the
cell value as DUPLICATE and a number (eg. DUPLICATE1)
C.Value = "DUPLICATE" & J 'if all 3 cells match set the original
cell value as DUPLICATE and a number (eg. DUPLICATE500)
Else
'DO NOTHING
End If
End If
End If
I = I + 1
J = J + 1
Next C 'do this for all of the cell values in column H
Dim RNG As Range
For J = 6 To toend 'change this to be the row numbers of your range
Set RNG = ActiveSheet.Range("H" & J) 'change this to be the column
'search through H6 to the ast cell in column H
number of your range
RNG.Select
If Left(RNG.Value, 9) = "DUPLICATE" Then 'if the left of the cell
value is duplicate
RNG.EntireRow.Delete 'delete the row
J = J - 1 'now check the row above (as we have just deleted a row)
Else
End If
Next J
End Sub
Shout if you have any more questions.
|