Solved: macro to Delete entire row based on a criteria.

[abhay_547]

Hi All,

I have the below macro which searches and deletes the rows from a column which contain error in formulas. It works fine I just want an additional thing is the same .i.e when my macro find a cell with error formula it should delete that row plus two more rows after that for e.g. If my macro finds that there is an error formula in row J5 then it should delete row J5,J6 and J7. Please expedite..


Sub Deleterowswitherrorformula ()

Sheets("Sheet1").Select
With Range("J1:J" & ActiveSheet.UsedRange.Rows.Count)
.SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete

End With

End Sub

Thanks for your help in advance...:bow:

[mdmackillop]

Does this work?
.SpecialCells(xlCellTypeConstants, xlErrors).Resize(3).EntireRow.Delete

[abhay_547]

Hi mdmackillop,

No It's not working. Please expedite..

[mdmackillop]

Option Explicit
Sub Deleterowswitherrorformula()
Dim arr(), i As Long, x As Long
Dim rng As Range, cel As Range
On Error GoTo exits
Set rng = Sheets("Sheet1").Columns(10).SpecialCells(xlCellTypeConstants, xlErrors)
ReDim arr(rng.Cells.Count)
For Each cel In rng
arr(i) = cel.Row
i = i + 1
Next
For x = i - 1 To 0 Step -1
Cells(arr(x), 1).Resize(3).EntireRow.Delete
Next
exits:
End Sub

[abhay_547]

Hi mdmackillop,

It's still not working. I tried using the macro posted by you, it didn't work and didn't show any error because you have used on error statement in the same. So to debug what's happening in the background and where the code is getting stuck. I have suppressed the On error line and found that the code is getting stuck on the below line and following is the error encountered.


Set rng = Sheets("Sheet1").Columns(10).SpecialCells(xlCellTypeConstants, xlErrors)

Error Encountered : Run-time Error '1004':
No Cells were found

Please expedite. I have checked the J column once again in my sheet and it contains the cells with "#REF!" errors.

Thanks for your help in advance. :bow:

[mdmackillop]

The code will fail if it finds no errors. Presumably your errors are not Constants. Try xlCellTypeFormulas

[abhay_547]

Hi mdmackillop,

Thanks a lot. It's working now. That was exactly what I wanted. However I need one more help from .i.e I need to apply reverse logic macro on a different sheet for e.g. If my J9 row contains an error in Formula .i.e #REF! then macro should insert 2 additional rows just below J9 and then go back and select J9 and offset 2 rows down and then do a selection from A to S column and select 2 rows for e.g. after inserting 2 rows below J9 it should select A11:S11 and then do the formatting using below code


Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With

Note : Macro should do the above exercise for each error formula row in column J.

[mdmackillop]

Please post your own "best code" to carry out the task. We are here to assist, not to provide a free coding service. The phrase "Please expidite" is not warranted. All here are give of their time to help others. If you wish an "expidited" service, there are paid code providers you can use.

[abhay_547]

Hi mdmackillop,

I am extremely sorrry, Here is my code :


Sub Insertrowsandformatafterrefrows()
Application.ScreenUpdating = False
ActiveSheet.Select
'selects the cell with error in formula
With Range("J1:J" & ActiveSheet.UsedRange.Rows.Count)
.SpecialCells(xlCellTypeFormulas, xlErrors).Rows.Select
Dim X As Range
For Each X In Selection
r = Selection.Row + 1
Range("B" & r & ":" & "S" & r).Select
Application.Run "DoFormatting" ' This Doformatting is a macro which will do the formatting of the selected cells
Next
End With

Application.ScreenUpdating = True
End Sub




Above code just formats one row after ref row but i am not able to put some line of code in the same which can insert 2 rows just below error formulas rows present in J column and then select J9 row once again and offset 2 rows and then do the formatting for 2 rows by selecting from B11:S12. Above code just does the formatting for B10:S10 and doesn't even loop through the J column to do the same exercise for the each row where it finds the ref rows.

Thanks a lot for your help in advance. :bow:

[mdmackillop]

Always use Option Explicit
Use Range variables and avoid Selection of cells. It is inefficient and can get confusing.

This will do the formatting of two rows below an error cell, as per your posted code.

Option Explicit
Sub Insertrowsandformatafterrefrows()
Dim X As Range, Rng As Range
Application.ScreenUpdating = False
With Range("J:J")
Set Rng = .SpecialCells(xlCellTypeFormulas, xlErrors)
For Each X In Rng
Application.Run "DoFormatting", X.Offset(1, -8).Resize(2, 18)
Next
End With
Application.ScreenUpdating = True
End Sub

Sub DoFormatting(r As Range)
r.Interior.ColorIndex = 7
r.Borders.LineStyle = xlContinuous
End Sub


If you wish to insert rows, use the same method I posted for deletion of cells in post #4, corrected as discussed.

[abhay_547]

Hi mdmackillop,

Thanks a lot for your help and sorry to bother you again but as suggested by you in I used the code posted by you in post #4 to insert rows and I am facing a issue with the same. the issue is the code inserts 2 rows before J9 and 2 rows after J9 and stops it doesn't do the same exercise for all error formula instances in column J. Any how I want my macro to insert 2 rows only below a error formula row and not above and then should it offset 2 rows from error formula row and select 2 rows and do the formatting same thing needs to be repeated for other instances as well. Following is the code which i am using after modifying.


Option Explicit
Sub Deleterowswitherrorformulagf()
Dim arr(), i As Long, X As Long
Dim Rng As Range, cel As Range

Range("J1:J" & ActiveSheet.UsedRange.Rows.Count).Select
On Error GoTo exits
Set Rng = Selection.SpecialCells(xlCellTypeFormulas, xlErrors)
ReDim arr(Rng.Cells.Count)
For Each cel In Rng
arr(i) = cel.Row
i = i + 1
Next
For X = i - 1 To 0 Step -1
Cells(arr(X), 1).Resize(2).EntireRow.Insert
Range("A8").Select
Next
exits:
End Sub

As far as formatting is concerned it's working fine. I just need the help on the above thing and then it will be done. Thanks a lot once again for your help.

Thanks a lot for your help in advance. :bow:

[mdmackillop]

Why are you selecting ranges? It is not necessary.
The error lies in these 3 lines. Step through the code to identify and remedy it. It is quite obvious and very simple to fix.

For X = i - 1 To 0 Step -1
Cells(arr(X), 1).Resize(2).EntireRow.Insert
Next

[abhay_547]

Hi mdmackillop,

Thanks a lot for quick reply but it's still not working I have removed the below line from my code which was probably creating problem .i.e it was making macro to insert rows above the error formula row but still it's not working.


Range("A8").Select
Code which I am using now is a below :




Option Explicit
Sub Deleterowswitherrorformulagf()
Dim arr(), i As Long, X As Long
Dim Rng As Range, cel As Range

Range("J1:J" & ActiveSheet.UsedRange.Rows.Count).Select
On Error GoTo exits
Set Rng = Selection.SpecialCells(xlCellTypeFormulas, xlErrors)
ReDim arr(Rng.Cells.Count)
For Each cel In Rng
arr(i) = cel.Row
i = i + 1
Next
For X = i - 1 To 0 Step -1
Cells(arr(X), 1).Resize(2).EntireRow.Insert
Next

exits:
End Sub
I am confused I am unable to figure out what is going wrong I tried running the code by making few changes but still it's not working. Please help me...:(

[mdmackillop]

Did you "STEP THROUGH" the code as suggested?
For X = i - 1 To 0 Step -1
Cells(arr(X)+1, 1).Resize(2).EntireRow.Insert
Next

[abhay_547]

Hi mdmackillop,

Thanks a lot, you are just awesome. It's working now. I just made a small change to the same from my end to meet my requirement. Finally it's working now. Here is the code.


Option Explicit
Sub Deleterowswitherrorformulagf()
Dim arr(), i As Long, X As Long
Dim Rng As Range, cel As Range

Columns("J:J").Select
On Error GoTo exits
Set Rng = Selection.SpecialCells(xlCellTypeFormulas, xlErrors)
ReDim arr(Rng.Cells.Count)
For Each cel In Rng
arr(i) = cel.Row
i = i + 1
Next
For X = i - 1 To 0 Step -1
Cells(arr(X) + 2, 1).Resize(2).EntireRow.Insert
Next
exits:
End Sub
Thanks a lot once again for your help...:beerchug:

[mdmackillop]

Glad you found the solution.

BTW, please use the green VBA button to format code postings here. "Code" tags don't format properly.

[abhay_547]

Ok. Going forward I will use VBA button to post my code. Anyways Once again thanks a lot for your help.:bow: