How do I discard unsaved changes without closing workbook? - vba

Right now I have this code that runs when the workbook is closed:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False
Dim wks As Worksheet
Select Case MsgBox("Do you really wish to close this file?", vbQuestion + vbOKCancel, "Close")
Case vbOK:
Sheets("Start").Visible = xlSheetVisible
For Each wks In ThisWorkbook.Worksheets
If Not wks.Name = "Start" Then
wks.Visible = xlVeryHidden
End If
Next wks
ThisWorkbook.Save
Case vbCancel:
Cancel = True
Exit Sub
End Select
Application.ScreenUpdating = True
End Sub
My problem is if an user make changes to the workbook, but at the end, doesn't want to save this changes, it ends up saving it anyway. Is there a way for me to revert to previous state before close? Like going to the previous save state, then running the beforeclose code?


You can just use a msgbox to ask for user confirmation, and only call ThisWorkbook.Save if the user selects yes, like so:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False
Dim wks As Worksheet
Select Case MsgBox("Do you really wish to close this file?", vbQuestion + vbOKCancel, "Close")
Case vbOK:
Sheets("Start").Visible = xlSheetVisible
For Each wks In ThisWorkbook.Worksheets
If Not wks.Name = "Start" Then
wks.Visible = xlVeryHidden
End If
Next wks
answer = msgbox("Do you want to save?")
If answer = vbYes Then
ThisWorkbook.Save
End If
Case vbCancel:
Cancel = True
Exit Sub
End Select
Application.ScreenUpdating = True
End Sub

Related

Delete a Worksheet upon Exit (if it exists) VBA

I am attempting to delete a worksheet from this Excel file upon exit (if it exists). The code I have tells it to automatically delete the sheet and say "yes, delete" in the popup box, but it is not running for some reason.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'
' This procedure will delete sheet upon exit and select "Yes, Delete" in the
' pop-up box
'
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = "Temp" Then
Application.DisplayAlerts = False
Worksheets("Temp").Delete
Application.DisplayAlerts = True
End If
Next
End Sub

You may try something like this...
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ws As Worksheet
Application.DisplayAlerts = False
On Error Resume Next
Set ws = Sheets("Temp")
If Not ws Is Nothing Then
ws.Delete
ThisWorkbook.Save
End If
Application.DisplayAlerts = True
End Sub

I think you should code
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
On Error Resume Next ' this will prevent subsequent line from stoping code should there be no "Temp" sheet
Sheets("Temp").Delete
Application.DisplayAlerts = True
Me.Save ' be sure you save the workbook before closing it
End Sub

Why does delete a sheet cause my code to stop

I have some code here (Below) I need to clear the data within the WorkSheet "Data Entry" there may be other, quicker, ways to do this, but i went with delete and remake. Please feel free to say if so.
Private Sub CommandButton1_Click()
Dim DataEntryWs As Worksheet
For i = Worksheets.Count To 1 Step -1
If Worksheets(i).Name = "Data Entry" Then
Application.DisplayAlerts = False
Worksheets("Data Entry").Delete
MsgBox ("Sheet Deleted")
Set DataEntryWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
DataEntryWs.Name = "Data Entry"
Call Data_Entry_Calcs
Else
If i = Worksheets.Count Then
MsgBox ("Adding new sheets now")
Set DataEntryWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
DataEntryWs.Name = "Data Entry"
Call Data_Entry_Calcs
Else
End If
End If
Next i
Call Data_Entry_Calcs
End Sub
Whenever I run the code, if the Sheet named "Data Entry" is present then when the code gets to this line Worksheets("Data Entry").Delete the code breaks and dosen't contiue. Why is this the case? Been annoying me for a while now.
I have tried running the For loop both forwards and backwards to see if this has made any difference, but had no success with it.

How about clearing the contents of that Sheet instead of deleting it, such as:
Private Sub CommandButton1_Click()
Dim DataEntryWs As Worksheet
For i = Worksheets.Count To 1 Step -1
If Worksheets(i).Name = "Data Entry" Then
Application.DisplayAlerts = False
Worksheets("Data Entry").Rows("2:" & Rows.Count).ClearContents 'clear the contents from Row 2 to last
Call Data_Entry_Calcs
Else
If i = Worksheets.Count Then
MsgBox ("Adding new sheets now")
Set DataEntryWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
DataEntryWs.Name = "Data Entry"
Call Data_Entry_Calcs
End If
End If
Next i
Call Data_Entry_Calcs
End Sub

Can you try this instead. You don't need the loop to do this if I understand what you're trying to do correctly
Private Sub CommandButton1_Click()
Dim DataEntryWs As Worksheet
' Set Sheet want to test to variable
' We use error handling in case it doesn't exist. If it doesn't exists DataEntryWs = nothing
On Error Resume Next
Set DataEntryWs = ThisWorkbook.Worksheets("Data Entry")
On Error GoTo 0
' Test if sheet exists. If does Delete
If Not DataEntryWs Is Nothing Then
Application.DisplayAlerts = False
DataEntryWs.Delete
Application.DisplayAlerts = True
MsgBox "Sheet Deleted"
End If
' Add new sheet
MsgBox "Adding new sheets now"
With ThisWorkbook
Set DataEntryWs = .Sheets.Add(after:=.Sheets(.Sheets.Count))
End With
DataEntryWs.Name = "Data Entry"
Call Data_Entry_Calcs
End Sub

Can you try this code and let me know what happens, and yes, I do get the messagebox when I run it...
Sub Test2()
Dim i As Integer
On Error GoTo err_handler
For i = Worksheets.Count To 1 Step -1
If Worksheets(i).Name = "Data Entry" Then
Application.DisplayAlerts = False
Worksheets("Data Entry").Delete
Application.DisplayAlerts = True
MsgBox ("Sheet Deleted")
End If
Next i
Exit Sub
err_handler:
MsgBox Err.Description
End Sub

Why not try just this?
Private Sub CommandButton1_Click()
Dim DataEntryWs As Worksheet
On Error Resume Next
Set DataEntryWs = Sheets("Data Entry")
On Error GoTo 0
If Not DataEntryWs Is Nothing Then
DataEntryWs.Cells.Clear
MsgBox "Sheet Data Entry cleared.", vbInformation
Else
MsgBox "Adding new sheet now.", vbInformation
With ThisWorkbook
Set DataEntryWs = .Sheets.Add(after:=.Sheets(.Sheets.Count))
DataEntryWs.Name = "Data Entry"
End With
End If
DataEntryWs.Activate
Call Data_Entry_Calcs
End Sub

Visible all sheets except specified two sheets

I have written some code to hide and unhide sheets by changing values in the 1st worksheet, how can I make all sheets visible except for the first 2 sheets?
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("H5").Value = "ADMIN" Then
Sheets(2).Visible = True
Sheets(2).Activate
Else
Sheets(2).Visible = xlVeryHidden
End If
If Range("G8").Value = True And Range("H5").Value = "" Then
Sheets(3).Visible = True 'I want to visible all sheets except first two sheets.
Sheets(4).Visible = True
Sheets(1).Visible = xlVeryHidden
Sheets(2).Visible = xlVeryHidden
Else
Sheets(3).Visible = xlVeryHidden
Sheets(4).Visible = xlVeryHidden
End If
End Sub

What you need to do is to loop thorugh all Sheets in your workbook, and if your Sheet.Index is larger than 2, then make the sheet Visible.
See loop below :
Dim Sht As Worksheet
' loop through all worksheets in this workbook
For Each Sht In ThisWorkbook.Worksheets
If Sht.Index > 2 Then ' check if index > 2
Sht.Visible = xlSheetVisible
Else
Sht.Visible = xlVeryHidden
End If
Next Sht
Entire Code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sht As Worksheet
If Range("H5").Value = "ADMIN" Then
Sheets(2).Visible = True
Sheets(2).Activate
Else
Sheets(2).Visible = xlVeryHidden
End If
If Range("G8").Value = True And Range("H5").Value = "" Then
For Each Sht In ThisWorkbook.Worksheets
If Sht.Index > 2 Then
Sht.Visible = xlSheetVisible
End If
Next Sht
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sht As Worksheet
If Range("H5").Value = "ADMIN" Then
Sheets(2).Visible = True
Sheets(2).Activate
Else
Sheets(2).Visible = xlVeryHidden
End If
If Range("G8").Value = True And Range("H5").Value = "" Then
For Each Sht In ThisWorkbook.Worksheets
If Sht.Index > 2 Then
Sht.Visible = xlSheetVisible
Sheets(1).Visible = xlVeryHidden
' Else
' Sht.Visible = xlVeryHidden
End If
Next Sht
'Else
' Sheets(3).Visible = xlVeryHidden
' Sheets(4).Visible = xlVeryHidden
End If
End Sub

edited to reflect Adnan last code
you may try this code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iSht As Long
Sheets(2).Visible = xlVeryHidden '<--| you'll make it visible if the case (see below)
Select Case Range("H5").Value '<--| check for H5 cell only once
Case "ADMIN"
Sheets(2).Visible = True
Sheets(2).Activate
Case ""
If Range("G8").Value Then '<--| check for it only when H5 cell value <> "ADMIN"
For iSht = 3 To Sheets.count '<--| loop through sheets indexes greater than 2, and avoid 'If ... Then' check
Sheets(iSht).Visible = True
Next iSht
Sheets(1).Visible = xlVeryHidden '<--| hide first sheet only once
End If
End Select
End Sub
which does the same things as yours but some logic improvements:
doesn't check twice for Range("H5").Value
doesn't check for Range("G8").Value uselessly after Range("H5").Value is "ADMIN"
doesn't make the If Sht.Index > 2 Then check at every For Each Sht In ThisWorkbook.Worksheets loop
doesn't set Sheets(1).Visible = xlVeryHidden at every For Each Sht In ThisWorkbook.Worksheets loop

VBA Excel not responding when copy data to another workbook

I use this simple code to copy my sheet from workbook 1 into workbook 2 in the same folder.
Sub Button27_Click()
Application.ScreenUpdating = False
Dim FileName As String
Workbooks.Open FileName:=ActiveWorkbook.Path & "\sefaresh.xlsm"
Application.Wait (Now + TimeValue("0:00:01"))
ThisWorkbook.Sheets("Sheet3").Copy
After:=Workbooks("sefaresh.xlsm").Sheets(Sheets.Count)
Application.ScreenUpdating = True
End Sub
The copy&paste function process successfully but if i close the workbook 2 first, i get not responding for excel. Any suggestion?
Thanks

Try this (Untested). You shouldn't get an error now.
Things become easier if you work with objects :)
Sub Button27_Click()
Dim wbThis As Workbook, wbThat As Workbook
Dim ws As Worksheet
Dim fName As String
On Error GoTo Whoa
Set wbThis = ThisWorkbook
Set ws = wbThis.Sheets("Sheet3")
fName = wbThis.Path & "\sefaresh.xlsm"
Application.ScreenUpdating = False
Set wbThat = Workbooks.Open(fName)
DoEvents
ws.Copy After:=wbThat.Sheets(wbThat.Sheets.Count)
'~~> close and save the workbook
wbThat.Close (True)
DoEvents '<~~ Give time for it to save and close
LetsContinue:
Application.ScreenUpdating = True
MsgBox "Done"
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub

On workbook open, Excel Macro to refresh all data connections sheets and pivot tables and then export the pivot to csv

I have an Excel File which has CSV Data sources and Pivot tables, I want to refresh all the data sources and pivot tables automatically and export one pivot table as CSV on opening the excel file.
I tried the below code, but this code export the CSV file before the data getting refreshed.
please help with a solution. Thanks in advance.
Private Sub Workbook_Open()
ThisWorkbook.RefreshAll
Run "Macro1"
End Sub
Sub Macro1()
Dim ws As Worksheet, newWb As Workbook
Dim SaveToDirectory As String
SaveToDirectory = "C:\Macro\"
Application.ScreenUpdating = False
For Each ws In Sheets(Array("locationwise"))
ws.Copy
Set newWb = ActiveWorkbook
With newWb
.SaveAs SaveToDirectory & ws.Name, xlCSV
.Close (False)
End With
Next ws
Application.ScreenUpdating = True
Application.DisplayAlerts = False
End Sub

A simple DoEvents should do the trick! ;)
Try this :
Private Sub Workbook_Open()
ThisWorkbook.RefreshAll
DoEvents
Run "Macro1"
End Sub
And if it's not, just add this line after the DoEvents :
Application.Wait(Now + TimeValue("0:00:05"))
This will put on hold the execution of the code, here for 5 seconds!
If you want to launch the save parts once a specific range has been modified, place your that code into the sheet module :
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, Me.Range(Rg_To_Check)) Is Nothing Then
'Not in range
Else
'In range to check
Run "Macro1"
End If
End Sub
And get rid of the Run "Macro1" in the Workbook_Open() event.
Also, be careful, because your last line is Application.DisplayAlerts = False you won't have alerts afterwards, you should use it like this instead :
Sub Macro1()
Dim ws As Worksheet, newWb As Workbook
Dim SaveToDirectory As String
SaveToDirectory = "C:\Macro\"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For Each ws In Sheets(Array("locationwise"))
ws.Copy
Set newWb = ActiveWorkbook
With newWb
.SaveAs SaveToDirectory & ws.Name, xlCSV
.Close (False)
End With
Next ws
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub