Making a model read-only

[Rainmanne]

I have a model made in Excel with VBA. I am sorry I cannot post it here as it's sensitive. But the model consists of a few worksheets with formulas linked to other worksheets, which are not in the model. All formulas are commented out to avoid errors. When you open the model it asks for another Excel file, copies two worksheet from there, uncomments the formulas that are linked to those two worksheets and asks to save it under a different name.

So I would like to make the model read-only for users. Thye reason for that is not that users might accidentally edit the file, they will not as all worksheets but one with just a big button saying RUN THE MODEL are hidden. The problem is that if when the model has run and offered to pick up a name for the resulted file in the Save As dialog, the user decides to abort, the model saves the resulted file under the same name as the model effectively making the model unusable for the next run.

However, I have run into a few issues when I made the file read-only.

First, there is a dialog box popping up every time you open a file giving an option to make the file editable and I cannot find a way to get rid of it.

Secondly, the resulted file is also saved as read-only but I need it to be saved normally.

Thirdly, when a user aborts the model on the saving result step, they face a Run-time 1004 dialog which might be confusing in terms of what option (End or Debug) to choose and after choosing the End option you still end up with the results in the model file. So when you close the file it still asks you whether you would like to save it. As the file is still Read-only, it gives you an error if you click on save and proposes to save under a different name (Copy of <file name>).

What I am trying to achieve now is a way to protect the model from being accidently saved with the results inside. I keep a master copy of the model so I can restore it any time but when I am away, people would have to wait for my return, which is not very convenient.

While I was writing this post I realised that my code to handle the model could be not very efficient and tweaking it might solve the issues I've got. So I am posting the code of the main macro here.

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 cdyearsno As Range
Dim numrows As Integer
Dim numrowscd As Integer
Dim c As Range
Dim decimaltab As Range
Dim d As Range

'Optimize Code
  Call OptimizeCode_Begin

Application.DisplayAlerts = False


'Import the data
Set activeWB = Application.ActiveWorkbook
FileOpenDial = Application.GetOpenFilename(FileFilter:="Excel Files (*.XML), *.XML", Title:="Select File To Be Opened")
If FileOpenDial = False Then Exit Sub
Set wb = Workbooks.Open(FileOpenDial)
    Sheets(Array("Data", "Types")).Select
    Sheets(Array("Data", "Types")).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

Sheets("AB").Visible = True
Sheets("CD").Visible = True
Sheets("tables").Visible = True

'Populate the prefab tables from the imported data
Sheets("AB").Select

'Remove apostrophe from the formulas
For Each c In Range("D1:D250").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

With ThisWorkbook.Sheets("AB")
    Set startcell = .Range("D1")
    Set endcell = Cells(Range("D" & Rows.Count).End(xlUp).Row, 3 + numrows + numrowsadj)
    Set finstart = .Range(startcell.Address & ":" & endcell.Address)
    finstart.FillRight
End With

Sheets("CD").Select

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

'FillRight Formulas
Set cdyearsno = ThisWorkbook.Sheets("AB").Range("C1:XFD1")
numrowscd = Application.WorksheetFunction.CountA(cdyearsno)

With ThisWorkbook.Sheets("CD")
    Set startcell = .Range("F1")
  
    If numrowscd = 3 Then
        Set endcell = Range("F" & Rows.Count).End(xlUp).Offset(, 1)
        Set finstart = .Range(startcell.Address & ":" & endcell.Address)
        finstart.FillRight
    ElseIf numrowscd > 3 Then
        Set endcell = Range("F" & Rows.Count).End(xlUp).Offset(, 2)
        Set finstart = .Range(startcell.Address & ":" & endcell.Address)
        finstart.FillRight
    Else
    End If
End With

'Activite tables
Sheets("tables").Select

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

'Hide the button
Sheets("Model").Visible = False

'Stop Optimize Code
Call OptimizeCode_End

'Pasting Coloured cells
'Range("E90:E99").Copy
'Range("G90").PasteSpecial Paste:=xlPasteFormats, Transpose:=True

'Formatting
Set decimaltab = [C2:E16,C25:E49,C62:E69,C71:E75,C77:E83,C104:E108,C110:E111,C115:E116,C137:C138]

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

ThisWorkbook.Worksheets("AB").Cells.SpecialCells(xlCellTypeVisible).EntireColumn.AutoFit
ThisWorkbook.Worksheets("CD").Cells.SpecialCells(xlCellTypeVisible).EntireColumn.AutoFit

ActiveWorkbook.Save

End Sub

 

[Candyman8019]

How about if you try saving it as a .xltm (macro-enabled template). This will prevent the user from saving over your master copy...unless they intentionally do so.

 

[Rainmanne]

How about if you try saving it as a .xltm (macro-enabled template). This will prevent the user from saving over your master copy...unless they intentionally do so.

Thankis a lot. Did not think about it. Probably it's an easier option.

 

[Candyman8019]

Just one thing to note, when saving as a template, Windows (at least on my system) ties to save the file in a "custom template" location...so when you're saving the master, make sure you put it in the correct location.

 

[Rainmanne]

Just one thing to note, when saving as a template, Windows (at least on my system) ties to save the file in a "custom template" location...so when you're saving the master, make sure you put it in the correct location.

Thanks a lot! I was just wondering where the file has gone after saving

 

[Rainmanne]

How about if you try saving it as a .xltm (macro-enabled template). This will prevent the user from saving over your master copy...unless they intentionally do so.

Sorry, have remembered the issue I had with this method. If a user opens the model by clicking on the file in File Explorer, it works perfectly as it opens a copy of the model under a slightly different name. However, if a user opens the model from Excel, then it opens the template itself. So in case of aborting the model run on the save as stage, the results will get saved in the model, exactly what I try to avoid.

 

[Candyman8019]

Try something like this:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
      If SaveAsUI = True Then 
          if environ("Username") <> "your user ID" then
              Cancel = True
          end if
     end if
End Sub