Save As does not work properly

[Rainmanne]

I have a snippet of code in the macro, which save a macro-enabled workbook under a different name before most of the code is run:

FileSaveAs = Application.GetSaveAsFilename(FileFilter:="Exel Files (*.xlsx), *.xlsx", Title:="Select Name To Save The File")
If FileSaveAs <> False Then
            ActiveWorkbook.SaveAs Filename:=FileSaveAs, _
            FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End If

It used to work without any issue. But recently it does not save a file under a name I chose but keeps the original name of the workbook. I do not know what happened, probably something which is run before the code or the changes in the network. Just in case, please see below the beginning of the code up to the save as part:

Sub UploadData()

Dim FileOpenDial As Variant
Dim FileSaveAs As Variant
Dim wb As Workbook
Dim activeWB As Workbook
Dim bFileSaveAs As Boolean
Dim finstart As Range
Dim endcell As Range, startcell As Range
Dim yearsno As Range
Dim numrowsadj As Integer
Dim cfyearsno As Range
Dim numrows As Integer
Dim numrowscf As Integer
Dim c As Range
Dim decimaltab As Range
Dim d As Range
Dim MySheets As Variant
Dim r As Range
Dim templvar As Variant
Dim cafvar As Variant
Dim tiervar As Variant
Dim wipevar As Variant
Dim SrchRng As Range, cel As Range
Dim ws As Worksheet

''Optimize Code
  
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
ActiveSheet.DisplayPageBreaks = False
Application.DisplayAlerts = False

UserForm1.Hide

''Import data

templvar = IIf(UserForm1.radioift, Array("Products", "Types"), Array("Products"))
    
    Set activeWB = Application.ActiveWorkbook
    FileOpenDial = Application.GetOpenFilename(FileFilter:="Excel Files (*.XML), *.XML", Title:="Select File To Be Opened")
    ''cancel pressed
    If FileOpenDial = False Then Exit Sub
    
    Set wb = Workbooks.Open(FileOpenDial, 0, True)
    
    wb.Worksheets(templvar).Copy Before:=activeWB.Sheets(1)
    wb.Close savechanges:=False 'or True

''Save a file

FileSaveAs = Application.GetSaveAsFilename(FileFilter:="Exel Files (*.xlsx), *.xlsx", Title:="Select Name To Save The File")
If FileSaveAs <> False Then
            ActiveWorkbook.SaveAs Filename:=FileSaveAs, _
            FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End If

 

[StephenCrump]

You're using: ActiveWorkbook.SaveAs ...

and there's nothing in the code you've posted to indicate what the ActiveWorkbook might be at the time.

From the question, it sounds like you want to save ThisWorbook. But that doesn't make sense if you save as an .xlsx and there's more code to be run?

 

[Rainmanne]

You're using: ActiveWorkbook.SaveAs ...

and there's nothing in the code you've posted to indicate what the ActiveWorkbook might be at the time.

From the question, it sounds like you want to save ThisWorbook. But that doesn't make sense if you save as an .xlsx and there's more code to be run?

Thanks a lot for your comment. I tried to replace ActiveWorkbook with ThisWorkbook but it did not help. It sometimes saves a workbook under the name I put in the SaveAs but other times it tries to save it under the original name. I am not sure what the problem is. The code actually runs without any issues and I can see all the macros in the VBA Editor after SaveAs. Only when I save it with Save, close and re-open, then the macros disappears. Another thing, if it saves the workbook under the original name, it ask to save it again when I try to close it. So if I do not, there is no changes in the workbook at all when you reopen it. At least, it save me a trouble to keep too many backup copies in case the SaveAs overwrites the original macro-enabled workbook.

 

[Rainmanne]

Have not found the solution yet. I think it might have something to do with OneDrive which is used for a home drive on the network, while the rest of the network is a normal network shares. If I open the model from the recent files in Excel, it often does not save a resulted work book under the new name. However, if I use Open from Excel menu and go the whole way from OneDrive to the folder where the model is located and open the model from there it seems to work correctly. Any idea, how top solve the issue. I cannot release the model to other users as it might mess up the the copy.

 

[StephenCrump]

It's still not at all clear what you want the code to do?

But it sounds like ThisWorkbook.SaveCopyAs might be the approach you're looking for?

 

[Rainmanne]

It's still not at all clear what you want the code to do?

But it sounds like ThisWorkbook.SaveCopyAs might be the approach you're looking for?

Basically, the model copies worksheets from another workbook and then uncomments formulas in hidden worksheets. So I need to save it under a different name. The new name is a choice of a user. Please see the full code below:

Option Explicit
Sub UploadData()

Dim FileOpenDial As Variant
Dim FileSaveAs As Variant
Dim wb As Workbook
Dim activeWB As Workbook
Dim bFileSaveAs As Boolean
Dim finstart As Range
Dim endcell As Range, startcell As Range
Dim yearsno As Range
Dim numrowsadj As Integer
Dim cfyearsno As Range
Dim numrows As Integer
Dim numrowscf As Integer
Dim c As Range
Dim decimaltab As Range
Dim d As Range
Dim MySheets As Variant
Dim r As Range
Dim templvar As Variant
Dim datavar As Variant
Dim tiervar As Variant
Dim wipevar As Variant
Dim SrchRng As Range, cel As Range
Dim ws As Worksheet, flg As Boolean
Dim Fldr As String

''Optimize Code
  
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
ActiveSheet.DisplayPageBreaks = False
Application.DisplayAlerts = False

UserForm1.Hide

''Import CreditLens data

templvar = IIf(UserForm1.radioift, Array("Data", "Types"), Array("Data"))
    
    Set activeWB = Application.ActiveWorkbook
    FileOpenDial = Application.GetOpenFilename(FileFilter:="Excel Files (*.XML), *.XML", Title:="Select File To Be Opened")
    ''cancel pressed
    If FileOpenDial = False Then
        Sheets("Model").CommandButton1.Visible = True
        Exit Sub
    Else
        Set wb = Workbooks.Open(FileOpenDial, 0, True)
    
        wb.Worksheets(templvar).Copy Before:=activeWB.Sheets(1)
        wb.Close savechanges:=False 'or True
    End If

''Save a file

'ActiveWorkbook.SaveAs Filename:=myFileName, FileFormat:=51

FileSaveAs = Application.GetSaveAsFilename(FileFilter:="Exel Files (*.xlsx), *.xlsx", Title:="Select Name To Save The File")
If FileSaveAs <> False Then
            ThisWorkbook.SaveAs Filename:=FileSaveAs, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'             ThisWorkbook.SaveAs Filename:=FileSaveAs, FileFormat:=51
'             MsgBox ThisWorkbook.FullName
Else
           ActiveWorkbook.Close savechanges:=False
End If

''Unhide sheets

If UserForm1.radioift.Value = True Then
    Sheets("FS_ABC").Visible = True
    Sheets("FS_ABC").Name = "FS"
    Sheets("CF_ABC").Visible = True
    Sheets("CF_ABC").Name = "CF"
Else
    Sheets("FS_XYZ").Visible = True
    Sheets("FS_XYZ").Name = "FS"
    Sheets("CF_XYZ").Visible = True
    Sheets("CF_XYZ").Name = "CF"
End If
Sheets("tables").Visible = True
Sheets("Calcs_table").Visible = True
Sheets("tables_for_present").Visible = True

''Build FS data tables
Sheets("FS").Select

''Remove apostrophe from the formulas
For Each c In Range("A1:F250").SpecialCells(xlCellTypeConstants)
    c.Formula = Replace(c.Formula, "'", "")
Next c

''FillRight Formulas
Set yearsno = ThisWorkbook.Sheets("Data").Range("F2:Z2")
numrows = Application.WorksheetFunction.CountA(yearsno)
    If 5 - numrows >= 0 Then
        numrowsadj = 0
    Else: numrowsadj = 5 - numrows
    End If
    

Set SrchRng = Range("A1:E1")

For Each cel In SrchRng
    If InStr(1, cel.Value, "Item") > 0 Then
        Set startcell = cel.Offset(, 1)
        Set endcell = cel.Cells(Rows.Count, 1).End(xlUp).Offset(, numrows + numrowsadj)
        Set finstart = ThisWorkbook.Sheets("FS").Range(startcell.Address & ":" & endcell.Address)
        finstart.FillRight
    End If
Next cel

ActiveSheet.Range("C1").Select

''Build CF data tables
Sheets("CF").Select

''Remove apostrophe from the formulas
For Each c In Range("A1:I260").SpecialCells(xlCellTypeConstants)
    c.Formula = Replace(c.Formula, "'", "")
Next c

numrowscf = numrows + numrowsadj
        
Set SrchRng = Range("A1:F1")

For Each cel In SrchRng
    If InStr(1, cel.Value, "Item") > 0 Then
        Set startcell = cel.Offset(, 1)
         If numrowscf = 3 Then
            Set endcell = startcell.Cells(Rows.Count, 1).End(xlUp).Offset(, 1)
            Set finstart = ThisWorkbook.Sheets("CF").Range(startcell.Address & ":" & endcell.Address)
            finstart.FillRight
        ElseIf numrowscf > 3 Then
            Set endcell = startcell.Cells(Rows.Count, 1).End(xlUp).Offset(, 2)
            Set finstart = ThisWorkbook.Sheets("CF").Range(startcell.Address & ":" & endcell.Address)
            finstart.FillRight
        Else
        End If

    End If
Next cel
        
ThisWorkbook.Sheets("CF").Range("E1").Select

''Activite the Summary tables
Sheets("tables").Select

For Each c In Range("C1:P160").SpecialCells(xlCellTypeConstants)
    c.Formula = Replace(c.Formula, "'", "")
Next c

Sheets("tables").Range("B1").Select

''Activate Calcs_table
Sheets("Calcs_table").Select
''Remove apostrophe from the formulas
For Each c In Range("B1:H22").SpecialCells(xlCellTypeConstants)
    c.Formula = Replace(c.Formula, "'", "")
Next c

If UserForm1.datatype.Value = "Public" Then
       Sheets("Calcs_table").Scenarios("Public").Show
Else
         If UserForm1.radiotier1.Value = True Then
                 Sheets("Calcs_table").Scenarios("Private Tier I").Show
         Else
                 Sheets("Calcs_table").Scenarios("Private Tier II").Show
         End If
End If

''Activate tables_for_present
Sheets("tables_for_present").Select
For Each c In Range("B2:O60").SpecialCells(xlCellTypeConstants)
    c.Formula = Replace(c.Formula, "'", "")
Next c

''Activate TOC sheets
If UserForm1.datatype.Value = "Public" Then
    Sheets("TOC_Pub").Visible = True
    Sheets("TOC_Pub").Select
    For Each c In Range("D5:I15").SpecialCells(xlCellTypeConstants)
        c.Formula = Replace(c.Formula, "'", "")
    Next c
Else
    If UserForm1.radiotier1.Value = True Then
        Sheets("TOC_Tier_I").Visible = True
        Sheets("TOC_Tier_I").Select
            For Each c In Range("D6:I15").SpecialCells(xlCellTypeConstants)
                c.Formula = Replace(c.Formula, "'", "")
            Next c
    Else
         Sheets("TOC_Tier_II").Visible = True
         Sheets("TOC_Tier_II").Select
            For Each c In Range("D6:I15").SpecialCells(xlCellTypeConstants)
                c.Formula = Replace(c.Formula, "'", "")
            Next c
    End If
End If
   

''Hide the working worksheets
Sheets(Array("Model", "Calcs_table")).Visible = False

''Stop Optimize Code

ActiveSheet.DisplayPageBreaks = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

''Autofit FS and CF
Worksheets("FS").Cells.SpecialCells(xlCellTypeVisible).Columns.WrapText = False
Worksheets("FS").Cells.SpecialCells(xlCellTypeVisible).Columns.AutoFit
Worksheets("CF").Cells.SpecialCells(xlCellTypeVisible).Columns.WrapText = False
Worksheets("CF").Cells.SpecialCells(xlCellTypeVisible).Columns.AutoFit

''Replace Conditional formating in the TOC table with normal
''tables_for_present

If UserForm1.wipe_format = True Then
    
Sheets("tables_for_present").Select

    Range("F4:O4").Select

    For Each r In Selection
        r.Interior.Color = r.DisplayFormat.Interior.Color
    Next r
    Selection.FormatConditions.Delete

    Range("B11:E20").Select

     For Each r In Selection
        r.Interior.Color = r.DisplayFormat.Interior.Color
    Next r
    Selection.FormatConditions.Delete
       ActiveSheet.Range("A1").Select

''TOC tables
        
    For Each ws In Sheets
        With ws
            If .Visible Then
                If UCase(ws.Name) Like "TOC*" Then
                ws.Select
                    Range("F6:I15").Select
                        For Each r In Selection
                            r.Interior.Color = r.DisplayFormat.Interior.Color
                            r.Value = r.Value
                        Next r
                        Selection.FormatConditions.Delete
                        ActiveSheet.Range("A1").Select
                End If
            End If
        End With
    Next ws
End If



'ThisWorkbook.Sheets("tables_for_present").Select
'    Sheets("tables_for_present").Range("A1").Select
'ThisWorkbook.Sheets("TOC_Tier_II").Select
'    Sheets("TOC_Tier_II").Range("C2").Select

''Formatting
''Decimal Formatting
''tables

Sheets("tables").Select
Set decimaltab = [C2:E16,C25:E54,C67:E87,C92:F92]

For Each d In decimaltab.SpecialCells(xlCellTypeFormulas, xlNumbers)
    If Abs(d.Value) < 101 And Round(d.Value, 1) <> 0 Then
        d.NumberFormat = "0.0;(0.0)"
    Else
        d.NumberFormat = "#,##0;(#,##0)"
   End If
Next d

''tables_for_present
Sheets("tables_for_present").Select
Set decimaltab = [B2:B3,B24:D28,B30:D31,B33:D36,B46:D47,B49:D52,B56:D56]

For Each d In decimaltab.SpecialCells(xlCellTypeFormulas, xlNumbers)
    If Abs(d.Value) < 101 And Round(d.Value, 0) <> 0 Then
        d.NumberFormat = "0.0;(0.0)"
    Else
        d.NumberFormat = "#,##0;(#,##0)"
   End If
Next d

Application.ScreenUpdating = True

ThisWorkbook.Save


End Sub

 

[Rainmanne]

Also, how should I convert the code:

FileSaveAs = Application.GetSaveAsFilename(FileFilter:="Exel Files (*.xlsx), *.xlsx", Title:="Select Name To Save The File")
If FileSaveAs <> False Then
            ThisWorkbook.SaveAs Filename:=FileSaveAs, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Else
           ActiveWorkbook.Close savechanges:=False
End If

to use

ThisWorkbook.SaveCopyAs

 

[Rainmanne]

OK, I have changed it to

FileSaveAs = Application.GetSaveAsFilename(FileFilter:="Exel Files (*.xlsx), *.xlsx", Title:="Select Name To Save The File")
If FileSaveAs <> False Then
             ThisWorkbook.SaveCopyAs Filename:=FileSaveAs
Else
           ActiveWorkbook.Close savechanges:=False
End If

I guess SaveCopyAs does not take FileFormat.

Nevertheless, it did not save the workbook under a different name. I suspect it's something to do with OneDrive. If both the model and the SaveAs destination are on the normal network, it works fine. But when I open the model from OneDrive, it's like hit and miss: sometime it saves it properly, sometimes under the same name as the model.