Delete row that are later than 4 quarters, excel stops responding after VBA code runs

[curlywurlyguy]

****** id="cke_pastebin" style="position: absolute; top: 0px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">

<tbody style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; font-size: inherit; line-height: inherit; font-family: inherit; vertical-align: baseline;">
[TD="class: votecell"]

down votefavorite1
​

[/TD]
[TD="class: postcell"] Good day to all!
I have a worksheet which is filled with data from Column A to G. Each row is a unique entity and Column G contains a value that shows how many quarters each data is reported late by from today. If the returned value is more 4 (that means the reported date was more than 4 quarters from today), the code would delete that particular row.
Currently my code runs for about 3 minutes, and I was wondering if there's anything else that I could do/restructure my code for it to run faster. Thanks in advance people! I have about 5000++ rows as of now.


[/TD]

</tbody>

</body>

<tbody style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; font-size: inherit; line-height: inherit; font-family: inherit; vertical-align: baseline;">
[TD="class: votecell"][/TD]
[TD="class: postcell"] I have a worksheet which is filled with data from Column A to G. Each row is a unique entity and Column G contains a value that shows how many quarters each data is reported late by from today. If the returned value is more 4 (that means the reported date was more than 4 quarters from today), the code would delete that particular row. My original code runs for about 3 minutes, which was a bit slow to me. I read up on forums saying using application.union would be faster but I can't figure out what's wrong with my code. Would be nice if someone can give me some input. Thanks in advance people! I have about 50000++ rows as of now.

<font face="inherit"><span style="font-style: inherit; font-variant-ligatures: inherit; font-variant-caps: inherit; font-weight: inherit;">

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
    Dim rngU As Range
    
    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
                    If QuarterValue > 4 Then
                        Set rng = .Range("G" & lRow)
                        If rngU Is Nothing Then
                            Set rngU = rng
                        Else
                            Set rngU = Union(rngU, rng)
                        End If
                    End If
                End If
            End With
            
        Next lRow
        
        If rngU Is Nothing Then
        Else
            rngU.EntireRow.Delete
        End If
    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
[FONT=inherit]

[/FONT]


[/TD]

</tbody>

 

[Fluff]

Cross posted https://stackoverflow.com/questions/48315494/tips-on-making-my-code-faster/48321892?noredirect=1#

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules). This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.