Delete rows based on a cell value

[djdiplomat]

Hi

I'm using the following to delete rows when cell value is blank. It first calculates the sum of the row column D to I, places the result in J then copies column J, paste special values then uses some more code to delete the blank cells.

This 'remove blank' code works fine on it's own but when run in this macro it tries to work but then I get 'Excel is not responding' and have to shut down. Is there a better way to achieve this? Length of data (rows) is always different.

Here is the code I'm using:

'Remove rows from Infor data

Sheets("Infor Data").Select
Range("J1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Empty"
Range("J2").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-5]:RC[-1])"
Range("J2").Select
Selection.AutoFill Destination:=Range("J2:J30000")
Range("J2:J30000").Select
Columns("J:J").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False

Sheets("Infor Data").Select
Columns("J:J").Select

Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Thanks

Will

 

[machopicho]

Hi

I'm using the following to delete rows when cell value is blank. It first calculates the sum of the row column D to I

Row 1?

Places the result in J

Why?

then copies column J

Where?
Which is final result you want to achieve?

 

[djdiplomat]

Row 1?
Why? Where?
Which is final result you want to achieve?

I basically have lots of rows of data. Columns D:I contain numerical values. I want the macro to delete all rows where the sum of columns D:I is zero.

Number of rows will be different each time as imported from a csv file from SQL server.

I want to get rid of the zero or blank rows to clean up the data.

Thanks

Will

 

[taurean]

Assuming that the complete row is blank, try this revised code. I have cleaned up the part created by macro recorder:

Dim lLastRow As Long
'Remove rows from Infor data
With Sheets("Infor Data")
.Range("J1").FormulaR1C1 = "Empty"
.Range("J2").FormulaR1C1 = "=SUM(RC[-5]:RC[-1])"
.Range("J2").AutoFill Destination:=Range("J2:J30000")
.Columns("J:J").Copy
.Columns("J:J").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.Columns("J:J").Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Application.CutCopyMode = False
lLastRow = .Range("A" & Rows.Count).End(xlUp).Row
    For i = lLastRow To 2 Step -1
        If .Range("A" & i).Value2 = "" Then
        .Rows(i).Delete
        End If
    Next i
End With

 

[machopicho]

Try this:

Sub test()
nr = Cells(Rows.Count, 4).End(xlUp).Row
For r = 1 To nr
Set inter = Range("D" & r & ":I" & r)
Cells(r, "J") = Application.WorksheetFunction.Sum(inter)
If Cells(r, "J") = "0" Then
Rows(r).Delete
End If
Next
End Sub