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
Related
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
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
I have a code that deletes a tab in the worksheet then runs another code. I am currently running into an issue that if the sheet is not there the code gives me an error... I'm wondering if I could make an if statement that looks if the tab is there and if not it moves on and if it is there it will delete it. I have the code that I have written already posted below but I have no idea how to do the if in the delete section.
Thanks!
Sub delete()
Dim ws As Worksheet
Set ws = Worksheets("Workbench Report")
Application.DisplayAlerts = False
ws.delete
Call Sorting
End Sub
Check if the sheet exists first:
Sub delete()
Dim ws As Worksheet
If WorksheetExists("Workbench Report") Then
Set ws = Worksheets("Workbench Report")
Application.DisplayAlerts = False
ws.delete
Call Sorting
End If
End Sub
Public Function WorkSheetExists(SheetName As String, Optional WrkBk As Workbook) As Boolean
Dim wrkSht As Worksheet
If WrkBk Is Nothing Then
Set WrkBk = ThisWorkbook
End If
On Error Resume Next
Set wrkSht = WrkBk.Worksheets(SheetName)
WorkSheetExists = (Err.Number = 0)
Set wrkSht = Nothing
On Error GoTo 0
End Function
Try this
Sub delete()
Dim i As Integer
i = 1
Application.DisplayAlerts = False
While i <= ActiveWorkbook.Worksheets.Count
Sheets(i).Select
If ActiveSheet.Name = "Workbench Report" Then
ActiveSheet.delete
End If
i = i + 1
Wend
Call Sorting
Application.DisplayAlerts = True
End Sub
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
Excel macro is intended to copy a range from one workbook to another using FileToOpen. The same code worked earlier today in separate workbook.
Error generated is Runtime 1004' PasteSpecial Method of class failed. Here's the section that fails:
SrcWB.Worksheets("1").Range("A1:K35").Copy
TgtWB.Sheets("1").Range("A1:K35").PasteSpecial (xlPasteValues)
TgtWB.Sheets("1").Range("A1:K35").PasteSpecial (xlPasteFormats)
Error gets caught on both PasteSpecial Values and Formats. I also tried to using:
SrcWB.Worksheets("1").Range("A1:K35").Value = TgtWB.Sheets("1").Range("A1:K35")
Above method didn't create any errors, however no values were transferred to the target workbook.
I've chewed on this most of this afternoon and would appreciate any help!
Here's the full code:
Sub CopySch()
Dim sh As Worksheet
Dim TgtWB As Workbook
Dim SrcWB As Workbook
Application.EnableEvents = False
Application.ScreenUpdating = False
Set TgtWB = ThisWorkbook
FileToOpen = Application.GetOpenFilename(FILEFILTER:="Excel Workbooks (*.xls*),*.xls*", Title:="Please select a file")
If FileToOpen = False Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
Else
Set SrcWB = Workbooks.Open(FileToOpen, xlUpdateLinksNever, ReadOnly:=True)
SrcWB.Worksheets("1").Range("A1:K35").Copy
TgtWB.Sheets("1").Range("A1:K35").PasteSpecial (xlPasteValues)
TgtWB.Sheets("1").Range("A1:K35").PasteSpecial (xlPasteFormats)
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
SrcWB.Close
End Sub
Goto the top of your module and add "Option Explicit".
Option Explicit
Sub CopySch()
Dim sh As Worksheet
Dim TgtWB As Workbook
Dim SrcWB As Workbook
...
It should solve your problem.
EDIT:
lets give another try with this code. i have tried the code it Works without error.
Option Explicit
Sub CopySch()
Dim sh As Worksheet
Dim TgtWB As Workbook
Dim SrcWB As Workbook
Dim FileToOpen As String
Application.EnableEvents = False
Application.ScreenUpdating = False
Set TgtWB = ThisWorkbook
FileToOpen = Application.GetOpenFilename(FILEFILTER:="Excel Workbooks (*.xls*),*.xls*", Title:="Please select a file")
If FileToOpen = "False" Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
Else
Set SrcWB = Workbooks.Open(FileToOpen, xlUpdateLinksNever, ReadOnly:=True)
SrcWB.Worksheets("1").Range("A1:K35").Copy
TgtWB.Sheets("1").Range("A1:K35").PasteSpecial (xlPasteValues)
TgtWB.Sheets("1").Range("A1:K35").PasteSpecial (xlPasteFormats)
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
SrcWB.Close
End Sub