CODEWITHSUNDEEP
vbaexcel
mystic_muffin
mystic_muffin

Reputation: 79

Delete worksheet when unmodified for XXX amount of time

Question: Is there a way that I can either delete a worksheet that hasn't been modified for 'X' number of days? Or transfer that inactive page from our active workbook into an archive book?

I'm working on a project that takes all the active worksheets (generated from job #) and summarizes the contained data. The worksheet names are all variable and generated based on data filled into a master sheet.

Once a job is completed, that worksheet will probably never need to be accessed again.

I appreciate any insight!

Upvotes: 0

Views: 145

Answers (1)

Tom
Tom

Reputation: 9888

Stick this in your ThisWorkbook object. It will update the tracker sheet (Sheet1 here) on any change done in any sheet on the workbook. Then on start, if the date difference is greater then a week a go, it will (when uncommented) delete the sheet. Change this if you want to do something different

Option Explicit
Private Sub Workbook_Open()
    Dim rng As Range
    Dim DayDiff As Long
    Dim c

    DayDiff = 7
    ' Update this to the sheet that you want to keep your timestamp list
    With Sheet1
        Set rng = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
        Application.DisplayAlerts = False
        For Each c In rng
            If c.Offset(0, 1) < Now() - DayDiff Then
                Debug.Print c
                'ThisWorkbook.Sheets(c.Value2).Delete
                'Range(c, c.Offset(0, 1)).Delete
            End If
        Next c
        Application.DisplayAlerts = True
    End With
End Sub
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
    Dim rng As Range
    Dim c
    ' Update this to the sheet that you want to keep your timestamp list
    With Sheet1
        If Not sh.Name = .Name Then
            Set rng = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
            Set c = rng.Find(sh.Name)
            If Not c Is Nothing Then
                c.Offset(0, 1) = Now()
            Else
                With .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1)
                    .Value2 = sh.Name
                    .Offset(0, 1) = Now()
                End With
            End If
        End If
    End With
End Sub

Upvotes: 1

Related Questions