Hi all, I have data in sheet (see below)

ROW A E F-----col
1 3080 G16 11
2 500 G16 12
3 -3080 G16 11
4 3080 G16 11
5 -3080 G16 11
6 -3080 G16 12
7 5040 G34 11
8 52590 G34 12
9 -5040 G34 11
10 5040 G34 11
11 -5040 G34 11
12 -5040 G34 12

I want macro which should check values in column E and F in row by row
like E1 & F1 and if E1 & F1 value match in any other row of column E
and F like in above table I have G16 and 11 in cell E1 & F1 and excect
value in cell E3 & F3 and so on. So when same row value in column E
and F match and in the same row of where those value matching if they
have debit and criedit amount in column A then both debit and credit
figures rows should be deleted. i hope that i have explained what i
am trying to say. Please if any friend can help.

Macro should bring result like this (see below)

ROW A E F-----col
1 500 G16 12
2 -3080 G16 12
3 52590 G34 12
4 -5040 G34 12

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.

On Apr 22, 12:47*pm, anon wrote:
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.

hi anon thank for replying. I checked your macro and it works fine
but it slightly giving different result on the sheet the one I got. I
already have macro in my sheet (please see below). It works fine but
as you can see that it only match value from column E and then delete
DR and CR figures from column A. but i want it look value in column F
as well as i explained in my question above. is it possible that you
can do some amendments in macro below and then it should check value
from column E & F and then delete DR and CR figures. as this macro
gives exact result what i want but just need to add column F which i
have no clue how i'll do it.

Sub DELDRCR()
HdgRow = 5
i1 = Cells(Rows.Count, "E").End(xlUp).Row
While i1 = HdgRow + 2
j1 = 1
While i1 - j1 HdgRow And Cells(i1, "E").Value = Cells(i1 -
j1, "E").Value
If -Cells(i1, "A") = Cells(i1 - j1, "A") _
And IsNumeric(Cells(i1, "D")) Then
Rows(i1).DELETE
Rows(i1 - j1).DELETE
i1 = i1 - 2
j1 = 0
End If
j1 = j1 + 1
Wend
i1 = i1 - 1
Wend
End Sub

The code I gave you checks columns E & F (if you've changed the ranges
to suit your sheet as i explained).

Basically my code finds the match in the first column, then checks the
next two columns. If they all match the rows will get deleted.

On Apr 22, 4:43*pm, anon wrote:
The code I gave you checks columns E & F (if you've changed the ranges
to suit your sheet as i explained).

Basically my code finds the match in the first column, then checks the
next two columns. If they all match the rows will get deleted.

Hi anon I just have few questions about your code so I can better
understand how it works. Can you please give me little bit
explaination if you don’t mind

1 - "I = 1" what this recommend
2 - "J = 500" what this recommend
3 - "For Each C In ActiveSheet.Range("H6:H17") " how can I change
this range to H6 to the last value cell in column H
4 - "C1 = C.Offset(0, 1).Value" which column this code is
recommending I or J
5 - "C2 = C.Offset(0, 2).Value" which column this code is
recommending J or K
6 - For J = 6 To 17 how can I change this row change from 6 to last
value cell row in column H

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.