Help speeding up code please

[AJC2012]

Hi,

I'm new to working with VBA and would very much appreciate some assistance with the following:

I've been working on some code that pulls data into a table in a new Sheet within a certain range, then deletes rows with zero value in columns E and I. I've managed to peice together the following that does the trick, but it seems a bit slow

Sub PivTEST()
'
    Range("C3") = "Option"
    Range("D3") = "Task"
    Range("E3") = "Resource"
    Range("F3") = "Hrs"
    Range("G3") = "Mats/Subs"
    Range("H3") = "Burden"
    Range("I3") = "Sort"
    Range("C4") = "='Input Sheet'!C5"
    Range("D4") = "='Input Sheet'!A5"
    Range("E4") = "='Input Sheet'!H5"
    Range("F4") = "='Input Sheet'!AF5"
    Range("G4") = "='Input Sheet'!AG5"
    Range("H4") = "='Upload'!E5"
    Range("I4") = "='Upload'!G5"
    Range("C4:I4").Select
    Selection.AutoFill Destination:=Range("C4:I5000"), Type:=xlFillDefault
    Range("C4:I5000").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Dim lrow As Long, i As Long
    Application.ScreenUpdating = False
    With ActiveSheet
           lrow = .Range("E" & .rows.Count).End(xlUp).Row
      For i = lrow To 4 Step -1
        If .Range("E" & i).Value = "0" Then .rows(i).Delete
        If .Range("I" & i).Value = "0" Then .rows(i).Delete
     Next i
    End With
    MsgBox "Deletion complete"
    Application.ScreenUpdating = True
End Sub

Does anyone have any suggestions for edits to this that would speed it up please?

If anyone could also explain what this bit really means aswell, that would be much appreciated:

 lrow = .Range("E" & .rows.Count).End(xlUp).Row
      For i = lrow To 4 Step -1

Thanks!

[AlphaFrog]

Try this...

Sub PivTEST()
    
    Dim lrow As Long, i As Long
    
    Range("C3:I3") = Array("Option", "Task", "Resource", "Hrs", "Mats/Subs", "Burden", "Sort")
    Range("C4:C5000").Value = Sheets("Input Sheet").Range("C5:C5001").Value
    Range("D4:D5000").Value = Sheets("Input Sheet").Range("A5:A5001").Value
    Range("E4:E5000").Value = Sheets("Input Sheet").Range("H5:H5001").Value
    Range("F4:F5000").Value = Sheets("Input Sheet").Range("AF5:AF5001").Value
    Range("G4:G5000").Value = Sheets("Input Sheet").Range("AG5:AG5001").Value
    Range("H4:H5000").Value = Sheets("Upload").Range("E5:E5001").Value
    Range("I4:I5000").Value = Sheets("Upload").Range("G5:G5001").Value
    
    On Error Resume Next
    Application.ScreenUpdating = False
    With Range("C3:I5000")
        .AutoFilter 1, 0    'Filter column C for zero
        .Offset(1).EntireRow.Delete
        .AutoFilter
        .AutoFilter 7, 0    'Filter column I for zero
        .Offset(1).EntireRow.Delete
        .Parent.AutoFilterMode = False
    End With
    Application.Screenpdating = True
    On Error GoTo 0
    
    MsgBox "Deletion complete"
    
End Sub

[RHCPgergo]

Hi AJC2012, welcome to the forum.

Here's some general advice:
1. You almost never need to "Select" objects. This also slows down the procedure.
2. Deleting rows one by one can be really slow. It's better to delete all at once.

Based on that I edited the code a little:

Option Explicit

Sub PivTEST()
'

Dim lRow As Long, i As Long
Dim Rng As Range

Range("C3") = "Option"
Range("D3") = "Task"
Range("E3") = "Resource"
Range("F3") = "Hrs"
Range("G3") = "Mats/Subs"
Range("H3") = "Burden"
Range("I3") = "Sort"
Range("C4") = "='Input Sheet'!C5"
Range("D4") = "='Input Sheet'!A5"
Range("E4") = "='Input Sheet'!H5"
Range("F4") = "='Input Sheet'!AF5"
Range("G4") = "='Input Sheet'!AG5"
Range("H4") = "='Upload'!E5"
Range("I4") = "='Upload'!G5"

Range("C4:I4").AutoFill Destination:=Range("C4:I5000"), Type:=xlFillDefault
With Range("C4:I5000")
    .Value = .Value
End With

lRow = Range("E" & Rows.Count).End(xlUp).Row

For i = 4 To lRow
    If Range("E" & i).Value = "0" Or Range("I" & i).Value = "0" Then
        If Rng Is Nothing Then
            Set Rng = Range("I" & i)
        Else
            Set Rng = Union(Rng, Range("I" & i))
        End If
    End If
Next i

Rng.EntireRow.Delete
MsgBox "Deletion complete"
    
End Sub

I hope it works for you. Cheers.

 lrow = .Range("E" & .rows.Count).End(xlUp).Row
      For i = lrow To 4 Step -1

This means that you contain the row number of the last row in the lrow variable, then start to loop back from lrow to 4.

[AJC2012]

That worked perfectly.

Thanks very much!