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

curlywurlyguy

New Member
Joined
Jan 19, 2018
Messages
1
****** id="cke_pastebin" style="position: absolute; top: 0px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">
down votefavorite1
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.



<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;">
</tbody>
</body>
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;">
HTML:
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]



<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;">
</tbody>
 

Some videos you may like

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
52,865
Office Version
  1. 365
Platform
  1. Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,421
Messages
5,596,033
Members
414,039
Latest member
southike

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top