The macro below is one that I use to break a large excel file (>40MB) into smaller files used by different teams. I run the macro below to filter out data in 5 worksheets that is not needed by a particular team which shrinks the files to under 5MB making them easier to use. The first four worksheets are all 70,000 rows of data downloaded from our planning system. The macro auto-filters then deletes about 1/3 to 2/3 of the rows. The last worksheet holds the lookup tables that drive the values in columns A and B on the four worksheets used to filter and delete. The VBA filters column A looking for "0" rows to be deleted, then it deletes the visible rows and finally removes the filter to show the remaining rows. I have a bit of a mystery I'm trying to solve. When the code runs initially it runs in 20 seconds which is great, but once I run it a few times to create files for different teams, the code slows to 5-7 minutes as excel stops responding. When I look at the task list excel is using 95-97% of memory. I've stepped through the code and when it slows, its on the "SpecialCells(xlCellTypeVisible).EntireRow.Delete" line. I can't figure out why the code runs so cleanly initially then uses so much memory on subsequent attempts. Do I need to include code to clear the excel cache? I don't think I'm using the clipboard when I'm filtering, but should I try to clear the clipboard? Any ideas or suggestions are appreciated, this one has me stumped.
VBA Code:
Sub Delete_Rows_Based_On_Value()
'
'Apply a filter to a Range and delete visible rows
'
Application.ScreenUpdating = False
Application.Calculation = xlManual
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Current Fcst")
ws.Activate
ws.Range("$A$3:$A$70000").Calculate
On Error Resume Next
ws.ShowAllData
On Error GoTo 0
ws.Range("$A$2:$W$70000").AutoFilter Field:=1, Criteria1:="=0"
ws.Range("$A$3:$W$70000").SpecialCells(xlCellTypeVisible).EntireRow.Delete
ws.AutoFilterMode = False
Set ws = ThisWorkbook.Worksheets("Prior Fcst")
ws.Activate
ws.Range("$A$3:$A$70000").Calculate
On Error Resume Next
ws.ShowAllData
On Error GoTo 0
ws.Range("$A$2:$W$70000").AutoFilter Field:=1, Criteria1:="=0"
ws.Range("$A$3:$W$70000").SpecialCells(xlCellTypeVisible).EntireRow.Delete
ws.AutoFilterMode = False
Set ws = ThisWorkbook.Worksheets("Budget")
ws.Activate
ws.Range("$A$3:$A$70000").Calculate
On Error Resume Next
ws.ShowAllData
On Error GoTo 0
ws.Range("$A$2:$W$70000").AutoFilter Field:=1, Criteria1:="=0"
ws.Range("$A$3:$W$70000").SpecialCells(xlCellTypeVisible).EntireRow.Delete
ws.AutoFilterMode = False
Set ws = ThisWorkbook.Worksheets("Prior Year")
ws.Activate
ws.Range("$A$3:$A$70000").Calculate
On Error Resume Next
ws.ShowAllData
On Error GoTo 0
ws.Range("$A$2:$W$70000").AutoFilter Field:=1, Criteria1:="=0"
ws.Range("$A$3:$W$70000").SpecialCells(xlCellTypeVisible).EntireRow.Delete
ws.AutoFilterMode = False
Set ws = ThisWorkbook.Worksheets("Drop Downs")
ws.Activate
ws.Range("$A$18:$A$150").Calculate
On Error Resume Next
ws.ShowAllData
On Error GoTo 0
ws.Range("$A$17:$C$150").AutoFilter Field:=1, Criteria1:="0"
ws.Range("$A$18:$C$150").SpecialCells(xlCellTypeVisible).EntireRow.Delete
ws.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub
Last edited by a moderator: