VBA Macro suddenly extremely slow. Need help in how to edit it.

[Lres81715]

I have this bit of code that Deletes all the unnecessary rows from my data sheet. On my other workbooks that use this nearly identical code, it runs in seconds.. Sometimes 5-10 seconds if there are a few calculations/formulas.

I got tasked to do the same thing for a large workbook that has a hidden sheet with a TON of calculations on it. Nearly 40K formulas and validation checks at last check.

My problem is, now my lovely bit of code slows down to a crawl. Taking upwards of 10 minutes to clean up the RawData before processing with other macros. The other macros work perfectly fine. Just this one seems to slow everything down.

Please help me clean this up so it runs much faster

Sub aALLDATA_Filter()

Dim ALLDATA As Worksheet 'Data Dump from ******.com comes in Unfiltered
Dim LastRow As Long      'Used to find the last row in ALLDATA. 
Dim iRow    As Long
Dim jRow    As Long '


Set ALLDATA = Sheets("ALLDATA") 'Data Dump worksheet




'====SCREEN UPDATE TURN OFF===
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.CutCopyMode = False


    Sheets("ALLDATA").Select

'====Delete Rows from Column AJ and AI on ALLDATA===


    LastRow = ALLDATA.Cells.Find("*", , xlFormulas, xlPart, xlByRows, xlPrevious).Row


   For iRow = LastRow To 2 Step -1
      If Cells(iRow, "AJ") <> "N" Then 'Deletes everything but N status
         Rows(iRow).Delete
      End If
   Next iRow


    LastRow = ALLDATA.Cells.Find("*", , xlFormulas, xlPart, xlByRows, xlPrevious).Row


   For jRow = LastRow To 2 Step -1
        If ALLDATA.Cells(jRow, "AI") <> "" Then 'Skips over rows with Blank Dates in AI as these are good
            If Application.WorksheetFunction.EoMonth(Date, -1) + 1 > Month(ALLDATA.Cells(jRow, "AI").Value) And Date - ALLDATA.Cells(jRow, "AI").Value > 15 Then 'Deletes any Row that is past 15 days from Current Date or Deletes Dates prior to current Month
                Rows(jRow).Delete
            End If
        End If
    Next


'====SCREEN UPDATE TURN ON===
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True


End Sub

I know the above two formulas can be combined into one but I lack the skill needed to combine them. Even if only one of them is running, the macro takes 8+ minutes on this report. So just combining them isn't going to save much time. The first cleans up 4800 rows to about 500 give or take. The second cleans up to about 140 rows or so.

Additional Notes: The ALLDATA worksheet has 320 Plus columns and 4800 rows and both are expanding on a daily and monthly basis.

Like I said above, the other macros on this report works fast and with no problems.

Any help or ideas would be appreciated. If nothing can be done to speed up the above code, can we edit it to possibly run from the original pulled worksheet before it's copy/pasted into this workbook? Then create some code to place it into the ALLDATA worksheet of this report. Just throwing out ideas. I don't have the skills required to do this or I would. Thanks for understanding.

 

[L. Howard]

AutoFilter may be a way to attack the sheet. Not sure, however.

Is it possible to post a link to a much reduced version of your workbook, say with 20 - 30 or so rows of example data. Then explain what should happen to what cell, rows etc. and why it should happen.

Appears to be a "if greater than..." and "if greater than 15..." then delete...

Aurofilter may be an option and then delete Specialcells.visible.

No attatchments allowed, but a like using one of the link utilities is ok. I use Drop Box, but there are others.

Howard

 

[Lres81715]

AutoFilter may be a way to attack the sheet. Not sure, however.

Is it possible to post a link to a much reduced version of your workbook, say with 20 - 30 or so rows of example data. Then explain what should happen to what cell, rows etc. and why it should happen.

Howard

Hello Howard,
I have a link to the above question provided in another MrExcel question. http://www.mrexcel.com/forum/excel-...-prior-15-days-today-prior-current-month.html

That should give you a truncated version of what's expected to happen.
When you go to the link above, the final bit of code at my final response is the one that works and performs perfectly. It's reflected in the code above.

Edit: Just to clarify, the code does work on a normal worksheet, it's just VERY slow on this heavily populated one filled with calculations and formulas.

 

[Eric W]

Here's a version that should run much quicker. It works for me, but my sample workbook is much smaller. Try this on a SAMPLE workbook first!

Sub aALLDATA_Filter()

Dim ALLDATA As Worksheet 'Data Dump from ******.com comes in Unfiltered
Dim LastRow As Long      'Used to find the last row in ALLDATA.
Dim iRow    As Long


Set ALLDATA = Sheets("ALLDATA") 'Data Dump worksheet


'====SCREEN UPDATE TURN OFF===
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.CutCopyMode = False


    Sheets("ALLDATA").Select

'====Delete Rows from Column AJ and AI on ALLDATA===

    LastRow = ALLDATA.Cells.Find("*", , xlFormulas, xlPart, xlByRows, xlPrevious).Row


    For iRow = LastRow To 2 Step -1
        If Cells(iRow, "AJ") <> "N" Then 'Deletes everything but N status
            Cells(iRow, "AJ") = "#N/A"
        End If
        If ALLDATA.Cells(iRow, "AI") <> "" Then 'Skips over rows with Blank Dates in AI as these are good
            If Application.WorksheetFunction.EoMonth(Date, -1) + 1 > Month(ALLDATA.Cells(iRow, "AI").Value) And Date - ALLDATA.Cells(iRow, "AI").Value > 15 Then 'Deletes any Row that is past 15 days from Current Date or Deletes Dates prior to current Month
                Cells(iRow, "AJ") = "#N/A"
            End If
        End If
    Next iRow


    Columns("AJ").SpecialCells(xlConstants, xlErrors).EntireRow.Delete


'====SCREEN UPDATE TURN ON===
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

I'm trying to create a better version still, but thought I'd let you try this one out first.

 

[Lres81715]

Eric!!
This did the trick!

I definitely have to remember that SpecialCells trick for the future.


It does run in about a minute now. Slow but not nearly as bad as before.
Thanks!

Would love to shave it down again but at this point, I'm not complaining. It's a lot faster now already

 

[Eric W]

Glad to help! That SpecialCells trick is pretty cool. The main thing to remember is that deleting 4000 rows with one command is MUCH faster than deleting them 1 at a time.

 

[L. Howard]

Hello Howard,

Edit: Just to clarify, the code does work on a normal worksheet, it's just VERY slow on this heavily populated one filled with calculations and formulas.

With that workable code and an example of the data, I was hoping to see if there was another worksheet method that could be used instead of a loop.

Howard

 

[Eric W]

That's one thing I was trying to improve about my version. For example, if there are a limited number of status codes, I can use the .Replace function instead of a loop. That should cut down a fair amount of time. That leaves us with the date comparisons. The best I can come up with for that is to read that whole column in one shot, then only update the cells that need changing. Both together should get the time down to a few seconds.

Lres81715, let me know if you'd like me to update it that way. If so, I'll need a list of all the possible status codes.