Trying to delete rows from a very large spreadsheet

[tannerle]

I am a novice at VBA and trying to figure this out with no luck. I currently use Excel 2003. In a very large workbook, I would like to find all rows that are more than three years old, or older than a certain date, and delete that row. There are roughly 360 worksheets in the workbook. However, all the worksheets do not need to be reviewed. All the dates are in column A, but not necessarily in order and some rows are blank. Any help would be appreciated as I try to reduce the size of this file. I believe one of my coworkers has "spreadsheet envy" and loves extremely large spreadsheets, which I now have inherited and must deal with. Thank you!

LT

 

[Michael M]

Hi LT and welcome to the Board
How many sheets need / do not need reviewing ?
What is the certain date that sets the criteria ?

 

[tannerle]

Hi LT and welcome to the Board
How many sheets need / do not need reviewing ?
What is the certain date that sets the criteria ?

So 360 sheets need reviewing, nine do not. I only need data from the last three years, so I would want to delete everything before July 1, 2009.

 

[tusharm]

The code below, which compiles OK but is otherwise untested, goes through all the worksheets.

Option Explicit

Sub deleteOldRows()
    Dim WS As Worksheet
    For Each WS In ActiveWorkbook.Worksheets
        Dim I As Long
        For I = WS.Cells(WS.Rows.Count, 1).End(xlUp).Row To 1 Step -1
            Dim aCell As Range: Set aCell = WS.Cells(I, 1)
            On Error Resume Next
            If Not IsDate(aCell.Value) Then
            ElseIf aCell.Value < DateSerial(2009, 7, 1) Then
                aCell.EntireRow.Delete
                End If
            On Error GoTo 0
            Next I
        Next WS
    End Sub

So 360 sheets need reviewing, nine do not. I only need data from the last three years, so I would want to delete everything before July 1, 2009.

 

[Fazza]

I wonder if the worksheets have a header row - in row 1? And would it be OK to sort the data on that field, as it should speed up the task significantly?

 

[tannerle]

I wonder if the worksheets have a header row - in row 1? And would it be OK to sort the data on that field, as it should speed up the task significantly?

There is a header row in row 1 on the 360 sheets I need to delete the data from. How do I make sure only those sheets have the rows deleted?

 

[Fazza]

There is a header row in row 1 on the 360 sheets I need to delete the data from. How do I make sure only those sheets have the rows deleted?

What distinguishes those worksheets? For example, is the cell "A1" entry always "Date" on the worksheets from which you want to delete data and it is not "Date" and the worksheets for which you do not want to delete data. If so, the VBA code can check the entry in cell A1 and respond accordingly. Or maybe it is the cell format or the worksheet name or whatever else that distinguishes the worksheets.

ALSO, is it OK to sort on the date field, column A? If the data can be sorted then the deletion can be done much faster. If it can be sorted, can it be left sorted or must it be returned to original order after deleting rows?

 

[Fazza]

Hi. Please back up your file before testing. HTH. Regards

Option Explicit

'Developed in Excel 2003
'Coded to be in an add-in that modifies the activeworkbook
'File assumed to be set up with some worksheets having tables of data
'
'Worksheets with cell "A1" value "Date" assumed to have row 1 header: date on these worksheets
'will be sorted on date and then records with data values more than some age will be deleted

Sub test()

  Const lng_MAXIMUM_YEARS_AGE_TO_KEEP_RECORDS As Long = 3

  Dim strFilter As String
  Dim wks As Worksheet, wbk As Workbook

  If ActiveWorkbook Is Nothing Then Exit Sub    'abort if there is no active workbook

  Set wbk = ActiveWorkbook
  'confirm that the code is to run on the activeworkbook
  If MsgBox(Prompt:=wbk.Name, Buttons:=vbYesNo, Title:="Try to delete records from file ...") = vbNo Then Exit Sub

  Application.ScreenUpdating = False
  Application.EnableEvents = False

  strFilter = "<" & CLng(DateAdd("yyyy", -lng_MAXIMUM_YEARS_AGE_TO_KEEP_RECORDS, Date))

  For Each wks In wbk.Worksheets
    If IsDataWorksheet(TestWks:=wks) Then Call DeleteOldRecords(FromWks:=wks, FilterColumn:=1, FilterText:=strFilter)
  Next wks
  Set wks = Nothing
  Set wbk = Nothing

  Application.EnableEvents = True
  MsgBox "Done"
End Sub


'data worksheets are identifiable by cell "A1" being value "Date"
Function IsDataWorksheet(ByRef TestWks As Worksheet) As Boolean
  IsDataWorksheet = False
  If TestWks.Range("A1").Value = "Date" Then IsDataWorksheet = True
End Function


Sub DeleteOldRecords(ByRef FromWks As Worksheet, ByVal FilterColumn As Long, ByVal FilterText As String)
  If FromWks.AutoFilterMode Then FromWks.Range("A1").AutoFilter    'remove any existing autofilter/s
  With FromWks.Range("A1").CurrentRegion
    .Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes    'for speed, sort data before deletions
    'remove unwanted records
    .AutoFilter Field:=FilterColumn, Criteria1:=FilterText, Operator:=xlAnd
    .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilter
  End With
End Sub