VBA Code works but crashes excel

[turbo805]

Hello,

Briefly I created a macro that saves my workbook as two versions--a macro enabled version and a non-macro enabled version.

The macro works correctly.

HOWEVER, it crashes my excel every time I run it.
Also as a background, my code saves the second workbook as the same name but with "DASHBOARD" added to the title. Hence the IF statement in my code.

Really what i'm looking for is a fix to the crashing and why my small brain cannot figure it out. I believe it has something to do with this line--wb.SaveAs (Path & WorkbookName).
Cheers!

Sub SaveWorkbook()

Dim wb As Workbook, wb2 As Workbook
Dim Path As String
Dim WorkbookName As String

WorkbookName = ActiveWorkbook.Name
Application.DisplayAlerts = False
Path = "C:\Users\" & Environ("Username") & "\Documents\"
Set wb = ThisWorkbook
wb.SaveAs (Path & WorkbookName)

If InStr(WorkbookName, ".") > 0 Then
   WorkbookName = Left(WorkbookName, InStr(WorkbookName, ".") - 1)
End If

Set wb2 = Workbooks.Open(Path & WorkbookName)
wb2.SaveAs Path & WorkbookName & " " & "DASHBOARD.xlsx", xlOpenXMLWorkbook
wb2.Close
Application.DisplayAlerts = True


End Sub

 

[turbo805]

My small brain figured out that it is not actually crashing. Both workbooks are being closed which results in a grey empty screen in excel because no files are open .

On that note, does anybody have a fix in my code to keep my original workbook open?

 

[turbo805]

Bump

 

[SpillerBD]

As soon as you performed a SaveAs. Newname, your original workbook was no longer open.
You'll need to reopen the file. Capture that name at the begging or your macro and then reopen it as the last step.

 

[turbo805]

Thanks for the reply. I was thinking the same thing but was still unable to execute it properly.

Here's what I tried.

Sub SaveWorkbook()

Dim wb As Workbook, wb2 As Workbook
Dim Path As String
Dim WorkbookName As String
Dim OriginalName As String


WorkbookName = ActiveWorkbook.Name
OriginalName = ActiveWorkbook.Name
Application.DisplayAlerts = False
Path = "C:\Users\" & Environ("Username") & "\Documents\"
Set wb = ThisWorkbook
wb.SaveAs (Path & WorkbookName)


If InStr(WorkbookName, ".") > 0 Then
   WorkbookName = Left(WorkbookName, InStr(WorkbookName, ".") - 1)
End If


Set wb2 = Workbooks.Open(Path & WorkbookName)
wb2.SaveAs Path & WorkbookName & " " & "Dashboard Version.xlsx", xlOpenXMLWorkbook
wb2.Close
Application.Workbooks.Open (Path & OriginalName)
Application.DisplayAlerts = True


End Sub

 

[Logit]

.

[COLOR=#000000][FONT=Consolas] Workbooks.Open Filename:=Path & [/FONT][/COLOR][COLOR=#333333]WorkbookName[/COLOR][COLOR=#000000][FONT=Consolas]
[/FONT][/COLOR]

 

[rlv01]

Try this:

Sub SaveWorkbook()

    Dim wb As Workbook, wb2 As Workbook
    Dim Path As String, WorkbookName As String, FName1 As String, FName2 As String

    WorkbookName = ActiveWorkbook.Name
    Path = "C:\Users\" & Environ("Username") & "\Documents\"
    Set wb = ThisWorkbook

    FName1 = Path & "Copy of " & WorkbookName
    wb.SaveCopyAs (FName1)

    If InStr(WorkbookName, ".") > 0 Then
        WorkbookName = Left(WorkbookName, InStr(WorkbookName, ".") - 1)
    End If

    FName2 = Path & WorkbookName & " " & "DASHBOARD.xlsx"

    Set wb2 = Workbooks.Open(FName1)
    Application.DisplayAlerts = False
    wb2.SaveAs FName2, xlOpenXMLWorkbook
    wb2.Close
    Application.DisplayAlerts = True
End Sub

 

[turbo805]

[COLOR=#000000][FONT=Consolas] Workbooks.Open Filename:=Path & [/FONT][/COLOR][COLOR=#333333]WorkbookName[/COLOR][COLOR=#000000][FONT=Consolas]
[/FONT][/COLOR]

This didn't work for me for some reason. I believe it's because i'm editing the original name with my IF statement in my code.

 

[turbo805]

This looks good rlv. The only problem is that it's now saving my original file as a copy which won't work as I'm using this Macro button daily. Any work around to not saving it as a copy?

 

[rlv01]

The only problem is that it's now saving my original file as a copy which won't work as I'm using this Macro button daily. Any work around to not saving it as a copy?

One way

Sub SaveWorkbook()
    Dim wb As Workbook, wb2 As Workbook
    Dim Path As String, WorkbookName As String, FName1 As String, FName2 As String

    WorkbookName = ActiveWorkbook.Name
    Path = "C:\Users\" & Environ("Username") & "\Documents\"
    Set wb = ThisWorkbook
    wb.Save                                           'save original

    FName1 = Path & "Copy of " & WorkbookName
    wb.SaveCopyAs (FName1)                            'save copy

    If InStr(WorkbookName, ".") > 0 Then
        WorkbookName = Left(WorkbookName, InStr(WorkbookName, ".") - 1)
    End If

    FName2 = Path & WorkbookName & " " & "DASHBOARD.xlsx"

    Set wb2 = Workbooks.Open(FName1)
    Application.DisplayAlerts = False
    wb2.SaveAs FName2, xlOpenXMLWorkbook              'use copy to save macro-free workbook
    wb2.Close
    VBA.Kill FName1                                   'delete copy
    Application.DisplayAlerts = True
End Sub