expire, clear content, save

R

ranthrave

Board Regular
Joined
Aug 26, 2010
Messages
141
Hello sir/maam!

I use this code to expire a workbook and close.
Can i ask to you if it's possible that after workbook expire it clear or delete all the contents in worksheets (all/specific worksheet) then eventually autosave then close.

Any insights or suggestion is much appreciated.

Code: 
 Private Sub Workbook_Open()
    Dim Edate As Date
    Edate = Format("20/11/2011", "DD/MM/YYYY") ' Replace this with the date you want
    If Date > Edate Then
        MsgBox ("This worksheet was valid upto " & Format(Edate, "dd-mmm-yyyy") & " and will be closed")
        ActiveWorkbook.Close
    End If
    If Edate - Date < 30 Then
    MsgBox ("This worksheet expires on " & Format(Edate, "dd-mmm-yyyy") & " You have " & Edate - Date & " Days left ")
    End If
End Sub
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Sort by date Sort by votes
ranthrave said:
Hello sir/maam!

I use this code to expire a workbook and close.
Can i ask to you if it's possible that after workbook expire it clear or delete all the contents in worksheets (all/specific worksheet) then eventually autosave then close.

Any insights or suggestion is much appreciated.

Code: 
 Private Sub Workbook_Open()
    Dim Edate As Date
    Edate = Format("20/11/2011", "DD/MM/YYYY") ' Replace this with the date you want
    If Date > Edate Then
        MsgBox ("This worksheet was valid upto " & Format(Edate, "dd-mmm-yyyy") & " and will be closed")
        ActiveWorkbook.Close
    End If
    If Edate - Date < 30 Then
    MsgBox ("This worksheet expires on " & Format(Edate, "dd-mmm-yyyy") & " You have " & Edate - Date & " Days left ")
    End If
End Sub
Click to expand...

Would this do what you want?

Code: 
 Private Sub Workbook_Open()
    Dim Edate As Date
    Edate = Format("20/11/2011", "DD/MM/YYYY") ' Replace this with the date you want
    If Date > Edate Then
        MsgBox ("This worksheet was valid upto " & Format(Edate, "dd-mmm-yyyy") & " and will be closed")
        Call ranthrave
        ActiveWorkbook.Close
    End If
    If Edate - Date < 30 Then
    MsgBox ("This worksheet expires on " & Format(Edate, "dd-mmm-yyyy") & " You have " & Edate - Date & " Days left ")
    End If
End Sub

In standard module

Code: 
Sub ranthrave()
Dim ws As Worksheet

For Each ws In Thisworkbook.Worksheets

    ws.Cells.Clear
    
Next ws
    
End Sub
 
Upvote 0
Thank you sir for reply.
But this is not I'm looking for
Code: 
 Sub ranthrave()
Dim ws As Worksheet

For Each ws In Thisworkbook.Worksheets

    ws.Cells.Clear
    
Next ws
    
End Sub
 
Upvote 0
You could specify each sheet that you want to clear if there are multiple sheets that you do not want to clear.

Code: 
Sub Macro3()
    Sheets(Array("Sheet1", "Sheet3")).Select
    Sheets("Sheet1").Activate
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
End Sub
 
Upvote 0
Jaye7 said:
You could specify each sheet that you want to clear if there are multiple sheets that you do not want to clear.

Code: 
Sub Macro3()
    Sheets(Array("Sheet1", "Sheet3")).Select
    Sheets("Sheet1").Activate
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
End Sub
Click to expand...

Thanks for reply sir

Let me again sir specify
Code: 
 Private Sub Workbook_Open()
    Dim Edate As Date
    Edate = Format("20/10/2011", "DD/MM/YYYY") ' Replace this with the date you want
    If Date > Edate Then
        MsgBox ("This worksheet was valid upto " & Format(Edate, "dd-mmm-yyyy") & " and will be closed")
        ActiveWorkbook.Close
    End If
    If Edate - Date < 30 Then
    MsgBox ("This worksheet expires on " & Format(Edate, "dd-mmm-yyyy") & " You have " & Edate - Date & " Days left ")
    End If
End Sub
Assuming the macro was enable.
After a period of time it will expired and close. And then I ask if it is possible or there's a code that will clear contents or delete sheets, then eventually autosave before it close?

something like expired --> (clear contents/ delete sheets --> autosave) --> close
 
Upvote 0
ranthrave said:
Thanks for reply sir

Let me again sir specify
Code: 
 Private Sub Workbook_Open()
    Dim Edate As Date
    Edate = Format("20/10/2011", "DD/MM/YYYY") ' Replace this with the date you want
    If Date > Edate Then
        MsgBox ("This worksheet was valid upto " & Format(Edate, "dd-mmm-yyyy") & " and will be closed")
        ActiveWorkbook.Close
    End If
    If Edate - Date < 30 Then
    MsgBox ("This worksheet expires on " & Format(Edate, "dd-mmm-yyyy") & " You have " & Edate - Date & " Days left ")
    End If
End Sub
Assuming the macro was enable.
After a period of time it will expired and close. And then I ask if it is possible or there's a code that will clear contents or delete sheets, then eventually autosave before it close?

something like expired --> (clear contents/ delete sheets --> autosave) --> close
Click to expand...

Still not sure I understand but, let's try again.

Code: 
Private Sub Workbook_Open()
    Dim Edate As Date
    Dim ws As Worksheet

    Edate = Format("20/11/2011", "DD/MM/YYYY") ' Replace this with the date you want
    If Date > Edate Then
        MsgBox ("This worksheet was valid upto " & Format(Edate, "dd-mmm-yyyy") & " and will be closed")

            For Each ws In ThisWorkbook.Worksheets

                ws.Cells.Clear
    
            Next ws
            
        ActiveWorkbook.Close SaveChanges:=True
    End If
    If Edate - Date < 30 Then
    MsgBox ("This worksheet expires on " & Format(Edate, "dd-mmm-yyyy") & " You have " & Edate - Date & " Days left ")
    End If

End Sub
 
Upvote 0
Thank You Very Much Sir John Davis

Buy the way sir, cells in some sheet can't clear it contents (because it was password protected).
Can I possibly targeted a specific cell range so that it will ignore protected cells?

Code: 
 Private Sub Workbook_Open()
    Dim Edate As Date
    Dim ws As Worksheet

    Edate = Format("20/11/2011", "DD/MM/YYYY") ' Replace this with the date you want
    If Date > Edate Then
        MsgBox ("This worksheet was valid upto " & Format(Edate, "dd-mmm-yyyy") & " and will be closed")

            For Each ws In ThisWorkbook.Worksheets

                ws.Cells.Clear
    
            Next ws
            
        ActiveWorkbook.Close SaveChanges:=True
    End If
    If Edate - Date < 30 Then
    MsgBox ("This worksheet expires on " & Format(Edate, "dd-mmm-yyyy") & " You have " & Edate - Date & " Days left ")
    End If

End Sub

Again thank you very much! :)
 
Upvote 0
ranthrave said:
Thank You Very Much Sir John Davis

Buy the way sir, cells in some sheet can't clear it contents (because it was password protected).
Can I possibly targeted a specific cell range so that it will ignore protected cells?

Code: 
 Private Sub Workbook_Open()
    Dim Edate As Date
    Dim ws As Worksheet

    Edate = Format("20/11/2011", "DD/MM/YYYY") ' Replace this with the date you want
    If Date > Edate Then
        MsgBox ("This worksheet was valid upto " & Format(Edate, "dd-mmm-yyyy") & " and will be closed")

            For Each ws In ThisWorkbook.Worksheets

                ws.Cells.Clear
    
            Next ws
            
        ActiveWorkbook.Close SaveChanges:=True
    End If
    If Edate - Date < 30 Then
    MsgBox ("This worksheet expires on " & Format(Edate, "dd-mmm-yyyy") & " You have " & Edate - Date & " Days left ")
    End If

End Sub

Again thank you very much! :)
Click to expand...

You're welcome. It's possible what is the specific cell range.
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question
Exiting a Textbox Problem
2
Replies
10
Views
166
Pacman52
P
A
  • Question
Creating a Calendar for a Month with tasks
Replies
0
Views
104
anuradhagrewal
A
B
  • Question
Delete sheets on password expiry
Replies
3
Views
327
bptaw
B
B
  • Solved
Set expiry date 10 days from opening workbook
2
Replies
11
Views
613
bptaw
B
J
  • Solved
Vba timestamp when pressing a button
Replies
4
Views
129
rollis13
rollis13

Forum statistics

Threads
1,214,576
Messages
6,120,350
Members
448,956
Latest member
Adamsxl

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top