CODEWITHSUNDEEP
vbaexcelmacrossave
AER
AER

Reputation: 1531

Why does Macro Stop Running When New Workbook Opened?

I'm using the following snippet of code to save the spreadsheet, make it value-only and re-save it. However the workbook opens then the macro stops running.

Why is this? And how do I stop it? I've tried setting ScreenUpdating = False to no avail.

Sub saveReport()
    Dim nwkbk As Workbook
    Dim thsWkbk As Workbook

    Set thsWkbk = ThisWorkbook

    nwkbkPath = thsWkbk.Path & "\x. Archive\" & Format(Date, "YYYY-MM-DD - ") & thsWkbk.Name

    ApplicationDisplayAlerts = False
    thsWkbk.SaveCopyAs nwkbkPath

    Set nwkbk = Workbooks.Open(nwkbkPath, False)

    For w = 1 To nwkbk.Sheets.Count
        nwkbk.Sheets(w).UsedRange = nwkbk.Sheets(w).UsedRange.Value
    Next w

    For wsp = 1 To nwkbk.Sheets.Count
        nwkbk.Sheets(wsp).Protect Password:="SettleDownBenny"
    Next wsp

    Application.DisplayAlerts = False
    nwkbk.Save

    nwkbk.Close

End Sub

Upvotes: 1

Views: 1686

Answers (2)

Glyphd
Glyphd

Reputation: 51

Answer: Your macro stops running because it is saved as an xlsm. Which may have event handlers start when it opens, and thus stop the original macro. UPDATE: In this case it was the Auto_Open method which runs automatically when the xlsm is opened.

How To Solve Your Problem: Use the Copy() method of Worksheets object to copy all worksheets from a workbook to a new one (originally just for the format as the formulae will not work). Then you'llneed to copy these as values alone using the .Value attribute to ensure all values verbatim are copied.Then the SaveAs() method is called to save it.

Code is as follows:

Sub saveReport()
Dim nwkbkPath As String
Dim w As Long


Set thsWorkbook = ThisWorkbook


With thsWorkbook '<--| reference 'ThisWorkbook'
    nwkbkPath = .Path & "\x. Archive\" & Format(Date, "YYYY-MM-DD - ") & GetName(.Name) '<--| use only the "strict" name (no extension) of ThisWorkbook
    .Sheets.Copy '<--| copy all worksheets from 'thsWkbk' to a new workbook, which also becomes the 'ActiveWorkbook'
End With


On Error GoTo ErrHandler
Application.DisplayAlerts = False

Set nwWorkbook = ActiveWorkbook

For w = 1 To nwWorkbook.Sheets.Count
    nwWorkbook.Sheets(w).UsedRange = thsWorkbook.Sheets(w).UsedRange.Value
Next w


For w = 1 To nwWorkbook.Sheets.Count
    nwWorkbook.Sheets(w).Protect Password:="SettleDownBenny"
Next w
nwWorkbook.SaveAs nwkbkPath


ActiveWorkbook.Close


ErrHandler:
    Application.DisplayAlerts = True
End Sub


Function GetName(wbName As String) As String
    GetName = Left(wbName, InStrRev(wbName, ".") - 1)
End Function

Upvotes: 1

user3598756
user3598756

Reputation: 29421

use Copy() method of Worksheets object to copy all worksheets from a workbook to a new one, on which to perform all needed operations and finally call SaveAs() method

as follows

Option Explicit

Sub saveReport()
    Dim nwkbkPath As String
    Dim w As Long

    With ThisWorkbook '<--| reference 'ThisWorkbook'
        nwkbkPath = .Path & "\x. Archive\" & Format(Date, "YYYY-MM-DD - ") & GetName(.name) '<--| use only the "strict" name (no extension) of ThisWorkbook
        .Sheets.Copy '<--| copy all worksheets from 'thsWkbk' to a new workbook, which also becomes the 'ActiveWorkbook'
    End With

    On Error GoTo ErrHandler
    Application.DisplayAlerts = False
    With ActiveWorkbook '<--| reference the ActiveWorkbook
        For w = 1 To .Sheets.Count
            .Sheets(w).UsedRange = .Sheets(w).UsedRange.Value
        Next w

        For w = 1 To .Sheets.Count
            .Sheets(w).Protect Password:="SettleDownBenny"
        Next w
        .SaveAs nwkbkPath
    End With
    ActiveWorkbook.Close

ErrHandler:
    Application.DisplayAlerts = True
End Sub

Function GetName(wbName As String) As String
    GetName = Left(wbName, InStrRev(wbName, ".") - 1)
End Function

where I also made some little refactoring of your original code

Upvotes: 1

Related Questions