MACRO TO DELET ROWS DEPENDING ON CELL VALUES

[K]

hi, I have data in range (A1:C1000) and this range can increase or
decrease depending on the data I receive and remove. See the little
version of data below that I have

ROW A B C -----col
1 GG ZZZ -100
2 GG BBB 200
3 SS HHH 300
4 TT XXX -600
5 VV GGG 200
6 XX TTT 900
7 GG UUU 700
8 YY AAA 400
9 TT XXX 600
10 VV GGG -200
11 ZZ FFF 600
12 GG ZZZ 100

I want macro which should check in whole column A and B cells that if
the same codes value in these columns have + and - figures in column C
cells then it should delete both those rows. For example as in above
data in row 1 I have code GG in cell A1 and code ZZZ in cell B1 then
macro should find both these codes in whole column A and B and see how
many times these both codes appearing in same row and if they have +
and - figures in column C in same row cell then both rows of those +
and - figures should be deleted. Note that the GG and ZZZ codes can
be appear ten times in column A & B and so macro should check all and
so on with other codes. Please if any friend can help me in this
matter. if someone can come up with small macro which can do this job
then it will much helpful but otherwise any macro will do.

 

[JLGWhiz]

Try this on a copy of your sheet first. It workded on my sample but you need
to test it before permanent installation.


Sub delZero()
Dim fRng As Range, LastCell As Range
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = lastRow To 2 Step -1
Set fRng = ActiveSheet.Range("A1:A" & Cells(i, 1).Row - 1) _
.Find(Cells(i, 1).Value, LookIn:=xlValues)
If Not fRng Is Nothing Then
For j = 1 To Cells(i, 1).Row
If ActiveSheet.Cells(i, 1).Value = fRng.Value And _
ActiveSheet.Cells(i, 2).Value = fRng.Offset(0, 1).Value _
And ActiveSheet.Cells(i, 3).Value + fRng.Offset(0, 2).Value = 0 Then
Cells(i, 1).EntireRow.Delete
fRng.EntireRow.Delete
Exit For
End If
Next
End If
Next
End Sub

 

[JLGWhiz]

If you have a header row, this will probably work better.

Sub delZero()
Dim fRng As Range, LastCell As Range
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = lastRow To 2 Step -1
Set fRng = ActiveSheet.Range("A2:A" & Cells(i, 1).Row - 1) _
.Find(Cells(i, 1).Value, After:=Cells(i - 1, 1), LookIn:=xlValues)
If Not fRng Is Nothing Then
For j = 1 To Cells(i, 1).Row
If ActiveSheet.Cells(i, 1).Value = fRng.Value And _
ActiveSheet.Cells(i, 2).Value = fRng.Offset(0, 1).Value _
And ActiveSheet.Cells(i, 3).Value + fRng.Offset(0, 2).Value = 0 Then
Cells(i, 1).EntireRow.Delete
fRng.EntireRow.Delete
Exit For
End If
Next
End If
Next
End Sub

 

[K]

If you have a header row, this will probably work better.

Sub delZero()
  Dim fRng As Range, LastCell As Range
  lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
  For i = lastRow To 2 Step -1
     Set fRng = ActiveSheet.Range("A2:A" & Cells(i, 1).Row - 1) _
     .Find(Cells(i, 1).Value, After:=Cells(i - 1, 1), LookIn:=xlValues)
     If Not fRng Is Nothing Then
     For j = 1 To Cells(i, 1).Row
     If ActiveSheet.Cells(i, 1).Value = fRng.Value And _
     ActiveSheet.Cells(i, 2).Value = fRng.Offset(0, 1).Value _
     And ActiveSheet.Cells(i, 3).Value + fRng.Offset(0, 2).Value =0 Then
       Cells(i, 1).EntireRow.Delete
       fRng.EntireRow.Delete
       Exit For
     End If
     Next
     End If
  Next
End Sub







- Show quoted text -

Hi JLGWhiz, Thanks for replying. i did tried your code but for some
reason its not deleting all the dr and cr figures rows. for instance
if you put the exact data the one i showed in my question into your
sheet and then run your macro then you'll see that it deletes few dr
and cr figures but leave few as well. i can send you my excel sheet
if you want me too so it can expalin you more clearly what i am tring
to do.

 

[JLGWhiz]

It could be that you have some extra spaces entered in some of the cells.
Try this version which trims out the extra spaces and see if it works better.

Sub delZero()
Dim fRng As Range, LastCell As Range
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = lastRow To 2 Step -1
Set fRng = ActiveSheet.Range("A2:A" & Cells(i, 1).Row - 1) _
.Find(Cells(i, 1).Value, After:=Cells(i - 1, 1), LookIn:=xlValues)
If Not fRng Is Nothing Then
For j = 1 To Cells(i, 1).Row
If Trim(ActiveSheet.Cells(i, 1).Value) = Trim(fRng.Value) And _
Trim(ActiveSheet.Cells(i, 2).Value) = Trim(fRng.Offset(0, 1).Value) _
And ActiveSheet.Cells(i, 3).Value + fRng.Offset(0, 2).Value = 0 Then
Cells(i, 1).EntireRow.Delete
fRng.EntireRow.Delete
Exit For
End If
Next
End If
Next
End Sub

Another thing to check is to make sure all of your DR and CR entries are
numeric.
If they are, they should align to the right of the column.

 

[K]

It could be that you have some extra spaces entered in some of the cells.  
Try this version which trims out the extra spaces and see if it works better.

Sub delZero()
  Dim fRng As Range, LastCell As Range
  lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
  For i = lastRow To 2 Step -1
     Set fRng = ActiveSheet.Range("A2:A" & Cells(i, 1).Row - 1) _
     .Find(Cells(i, 1).Value, After:=Cells(i - 1, 1), LookIn:=xlValues)
     If Not fRng Is Nothing Then    
     For j = 1 To Cells(i, 1).Row
     If Trim(ActiveSheet.Cells(i, 1).Value) = Trim(fRng.Value) And_
     Trim(ActiveSheet.Cells(i, 2).Value) = Trim(fRng.Offset(0, 1).Value) _
     And ActiveSheet.Cells(i, 3).Value + fRng.Offset(0, 2).Value =0 Then
       Cells(i, 1).EntireRow.Delete
       fRng.EntireRow.Delete
       Exit For
     End If
     Next
     End If
  Next
End Sub

Another thing to check is to make sure all of your DR and CR entries are
numeric.
If they are, they should align to the right of the column.






- Show quoted text -

Thanks lot JLGWhiz, your code working superb. i have tried it on a
sample sheet and it working very good. i'll go to my office on Monday
and will try this on original sheet and if i have any question then
i'll come back to you. Thanks lot again my friend.

 

[K]

Thanks lot JLGWhiz, your code working superb.  i have tried it on a
sample sheet and it working very good.  i'll go to my office on Monday
and will try this on original sheet and if i have any question then
i'll come back to you.  Thanks lot again my friend.- Hide quoted text -

- Show quoted text -

Thanks man your code working superb