CODEWITHSUNDEEP
excelvbaautomationspreadsheet
Igor Santana
Igor Santana

Reputation: 13

Automation Error deleting Sheet

I have this code that creates a new sheet and hides it to keep the historical data, but I need to delete all sheets older then a month to avoid my worksheet becoming too big in size.

I tried counting my for from 30 to 60 and 60 to 30 already. 

Sub Historico_DAR()

' Historico_DAR Macro

    Dim LDate, PDate As String
    Dim ws As Worksheet
    Dim wks As Worksheet
    Dim i As Integer

    LDate = Format(DateSerial(Year(Date), Month(Date), Day(Now)), "dd-mmm-yy")
    PDate = Format(DateSerial(Year(Date), Month(Date), Day(Now) - 30), "dd-mmm-yy")
    Worksheets("Sheet69").Range("A1").Value = PDate

'CODE Giving Atomation Error, the rest is OK

     For Each wks In Worksheets
       For i = 60 To 30 Step -1
         PDate = Format(DateSerial(Year(Date), Month(Date), Day(Now) - i), "dd-mmm-yy")
           If wks.Name = PDate Then
              Application.DisplayAlerts = False
              Sheets(PDate).Delete
              Application.DisplayAlerts = True
           End If
       Next
    Next

'End of the code giving me problems

    For Each ws In Worksheets
       If ws.Name = LDate Then
        Application.DisplayAlerts = False
        Sheets(LDate).Delete
        Application.DisplayAlerts = True
        End If
    Next

    Sheets("Atual").Select
    Sheets("Atual").Copy Before:=Sheets(9)
    Worksheets("Atual (2)").Range("A1:P476").Value = Worksheets("Atual").Range("A1:P476").Value
    Sheets("Atual (2)").Select
    Sheets("Atual (2)").Name = LDate
    Sheets(LDate).Visible = False
End Sub

Upvotes: 1

Views: 373

Answers (2)

YowE3K
YowE3K

Reputation: 23984

Just in case you take holidays and it is more than two months since you last deleted old sheets, you can delete anything older than 30 days (rather than just the ones between 30 and 60 days old), by using the sheet name itself in the condition:

For Each wks In Worksheets
    If IsDate(wks.Name) Then
        If (Date() - 30) > CDate(wks.Name) Then
            Application.DisplayAlerts = False
            wks.Delete
            Application.DisplayAlerts = True
        End If
    End If
Next

And this could be combined with your next loop by extending the If

For Each wks In Worksheets
    If IsDate(wks.Name) Then
        If (Date() - 30) > CDate(wks.Name) Or Date() = CDate(wks.Name) Then
            Application.DisplayAlerts = False
            wks.Delete
            Application.DisplayAlerts = True
       End If
    End If
Next

Also note that

LDate = Format(DateSerial(Year(Date), Month(Date), Day(Now)), "dd-mmm-yy")
PDate = Format(DateSerial(Year(Date), Month(Date), Day(Now) - 30), "dd-mmm-yy")

can be simplified to either

LDate = Format(Date(), "dd-mmm-yy")
PDate = Format(Date() - 30, "dd-mmm-yy")

or

LDate = Format(Now(), "dd-mmm-yy")
LDate = Format(Now() - 30, "dd-mmm-yy")

Upvotes: 2

user4039065
user4039065

Reputation:

This may a time when On Error Resume Next is actually useful.

On Error Resume Next
Application.DisplayAlerts = False
For i = 60 To 30 Step -1
    PDate = Format(Date - i, "dd-mmm-yy")
    Sheets(PDate).Delete
Next i
Application.DisplayAlerts = True
On Error GoTo 0

Get rid of the worksheet loop altogether.

Upvotes: 2

Related Questions