I have a worksheet which is filled with data from Column A to G. Each row is a unique entity and Column G represents how long ago (in quarters) the data was reported. The purpose of the code is to check if the value is more than 4 (that means the reported date was more than 4 quarters from today), and if so, the code would delete that particular row.
Currently my code takes about 3 minutes to run, and I was wondering if there's anything else that I could do/restructure my code for it to run faster.
I have about 5000++ rows as of now.
Sub Two_Keep3Quarters() Dim Firstrow As Long Dim Lastrow As Long Dim lRow As Long Dim Tbl As ListObject Dim rng As Range Dim QuarterValue As Long With Application .Calculation = xlCalculationManual .ScreenUpdating = False End With With Sheets("Filtered Data") .DisplayPageBreaks = False 'Set the first and last row to loop through Firstrow = 3 Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row 'We loop from Lastrow to Firstrow (bottom to top) For lRow = Lastrow To Firstrow Step -1 QuarterValue = .Range("G" & lRow).Value 'We check the values in the Column G With .Cells(lRow, "G") If Not IsError(QuarterValue) Then If QuarterValue > 4 Then .EntireRow.Delete 'This will delete each row with value of more than 4 quarters End If End With Next lRow End With Range("F1").Value = "Quarters" Range("G1").Value = "No. of Quarters" On Error Resume Next Set rng = Range(Range("A1"), Range("G1").End(xlDown)).SpecialCells(xlCellTypeBlanks) rng.Rows.Delete Shift:=xlShiftUp For Each Tbl In Sheets("Filtered Data").ListObjects Tbl.Unlist Next Set Tbl = ActiveSheet.ListObjects.Add(xlSrcRange, Range(Range("A1"), Range("G1").End(xlDown)), , xlYes) With Tbl .Name = "DataTable" .TableStyle = "TableStyleLight10" End With Application.ScreenUpdating = True End Sub