VBA to create sheets from a template based off a list in the master sheet not working when protected

I

Ibis2653

New Member
Joined
Aug 2, 2023
Messages
6
Office Version
  1. 365
Platform
  1. Windows
I am a bit new to VBA still, I got this code from another post on this forum but its a bit old and hasn't had a reply for 3 years.
I am running into a problem, I have the sheet protected and a button to run the code. when the sheet it protected I get an error saying it cant be run on a protected sheet. If I remove the .SpecialCells(xlConstants) from the set shNames line it will run but then I get a type mismatch error on the line If Not Evaluate("ISREF('" & NmSTR & "'!A1)") And wsMASTER.Range("G" & Nm.Row).Value = "Proceed" Then. The code works fine when unprotected. Thanks for your help

VBA Code: 
Option Explicit
Sub EvalSheetSummaryContractor()

'Create copies of a template sheet using text on a master sheet in a specific column
Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wasVISIBLE As Boolean
Dim shNAMES As Range, Nm As Range, NmSTR As String


Application.ScreenUpdating = False                              'stops the screen updating and make the code run faster
With ThisWorkbook                                               'keep focus in this workbook
    Set wsTEMP = .Sheets("Template")                            'sheet to be copied
    wasVISIBLE = (wsTEMP.Visible = xlSheetVisible)              'check if it's hidden or not
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetVisible      'make it visible
  
    Set wsMASTER = .Sheets("SUMMARY - CONTRACTORS")                    'sheet with names
                                                                'range to find names to be checked
    Set shNAMES = wsMASTER.Range("B4:B153").SpecialCells(xlConstants)     'or xlFormulas
  
    For Each Nm In shNAMES                                      'check one name at a time
        NmSTR = FixStringForSheetName(CStr(Nm.Text))            'use UDF to create a legal sheetname
        If Not Evaluate("ISREF('" & NmSTR & "'!A1)") And wsMASTER.Range("G" & Nm.Row).Value = "Proceed" Then       'if sheet does not exist and pre-requisite is proceed...
            wsTEMP.Copy After:=Sheets("Ranking")                 '...create it from template
            ActiveSheet.Name = NmSTR                            '...rename it
        End If
    Next Nm
  
    'orders the sheets the same as they appear on the summary page
   Dim MasterOrder As Collection
    Set MasterOrder = New Collection
  
    On Error Resume Next
    For Each Nm In shNAMES                                      'checks one name at a time
        MasterOrder.Add Sheets(Nm.Value), CStr(Nm.Value)        'checks where those sheets are in the master list
        Next Nm
        On Error GoTo 0
        Dim i As Long
        For i = 1 To MasterOrder.Count                                      'puts new sheets into a new collection
            Sheets(MasterOrder(i).Name).Move After:=Sheets(.Sheets.Count)   'moves the sheets to the end of all other sheets in order they appear on the summary page
        Next i
      
    wsMASTER.Activate                                           'return to the master sheet
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetHidden       'hide the template if necessary
    Application.ScreenUpdating = True                           'update screen one time at the end
End With
End Sub

Function FixStringForSheetName(shSTR As String) As String

'replace each forbidden character with something acceptable
    shSTR = Replace(shSTR, ":", "")
    shSTR = Replace(shSTR, "?", "")
    shSTR = Replace(shSTR, "*", "")
    shSTR = Replace(shSTR, "/", "-")
    shSTR = Replace(shSTR, "\", "-")
    shSTR = Replace(shSTR, "[", "(")
    shSTR = Replace(shSTR, "]", ")")

'sheet names can only be 31 characters
    FixStringForSheetName = Trim(Left(shSTR, 31))

End Function
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
Sort by date Sort by votes
above and below I added the formula for Protect & Unprotect Sheets, and u just change "a" with the password protected each sheets


VBA Code: 
Option Explicit

Sub EvalSheetSummaryContractor()



'Create copies of a template sheet using text on a master sheet in a specific column

Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wasVISIBLE As Boolean

Dim shNAMES As Range, Nm As Range, NmSTR As String


    Set wsMASTER = .Sheets("SUMMARY - CONTRACTORS")                    'sheet with names
    Set wsTEMP = .Sheets("Template")                            'sheet to be copied


'-----------------------

ActiveSheet.wsMASTER.Unprotect = "a"  'Change "a" with ur Password Protected Sheets("Template")
ActiveSheet.wsTEMP.Unprotect = "a"  'Change "a" with ur Password Protected Sheets("SUMMARY - CONTRACTORS")

'-----------------------


Application.ScreenUpdating = False                              'stops the screen updating and make the code run faster

With ThisWorkbook                                               'keep focus in this workbook



    wasVISIBLE = (wsTEMP.Visible = xlSheetVisible)              'check if it's hidden or not

    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetVisible      'make it visible


                                                                'range to find names to be checked

    Set shNAMES = wsMASTER.Range("B4:B153").SpecialCells(xlConstants)     'or xlFormulas

 

    For Each Nm In shNAMES                                      'check one name at a time

        NmSTR = FixStringForSheetName(CStr(Nm.Text))            'use UDF to create a legal sheetname

        If Not Evaluate("ISREF('" & NmSTR & "'!A1)") And wsMASTER.Range("G" & Nm.Row).Value = "Proceed" Then       'if sheet does not exist and pre-requisite is proceed...

            wsTEMP.Copy After:=Sheets("Ranking")                 '...create it from template

            ActiveSheet.Name = NmSTR                            '...rename it

        End If

    Next Nm

 

    'orders the sheets the same as they appear on the summary page

   Dim MasterOrder As Collection

    Set MasterOrder = New Collection

 

    On Error Resume Next

    For Each Nm In shNAMES                                      'checks one name at a time

        MasterOrder.Add Sheets(Nm.Value), CStr(Nm.Value)        'checks where those sheets are in the master list

        Next Nm

        On Error GoTo 0

        Dim i As Long

        For i = 1 To MasterOrder.Count                                      'puts new sheets into a new collection

            Sheets(MasterOrder(i).Name).Move After:=Sheets(.Sheets.Count)   'moves the sheets to the end of all other sheets in order they appear on the summary page

        Next i

     

    wsMASTER.Activate                                           'return to the master sheet

    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetHidden       'hide the template if necessary

    Application.ScreenUpdating = True                           'update screen one time at the end

End With


'-----------------------

ActiveSheet.wsMASTER.Protect = "a"  'Change "a" with ur Password Protected Sheets("Template")
ActiveSheet.wsTEMP.Protect = "a"  'Change "a" with ur Password Protected Sheets("SUMMARY - CONTRACTORS")

'-----------------------



End Sub



Function FixStringForSheetName(shSTR As String) As String



'replace each forbidden character with something acceptable

    shSTR = Replace(shSTR, ":", "")

    shSTR = Replace(shSTR, "?", "")

    shSTR = Replace(shSTR, "*", "")

    shSTR = Replace(shSTR, "/", "-")

    shSTR = Replace(shSTR, "\", "-")

    shSTR = Replace(shSTR, "[", "(")

    shSTR = Replace(shSTR, "]", ")")



'sheet names can only be 31 characters

    FixStringForSheetName = Trim(Left(shSTR, 31))



End Function
 
Upvote 0
haha sorry i spam reply because i cant delete my reply,focus on my last reply ya :)
 
Upvote 0
SunnyAlv said:
above and below I added the formula for Protect & Unprotect Sheets, and u just change "a" with the password protected each sheets


VBA Code: 
Option Explicit

Sub EvalSheetSummaryContractor()



'Create copies of a template sheet using text on a master sheet in a specific column

Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wasVISIBLE As Boolean

Dim shNAMES As Range, Nm As Range, NmSTR As String


    Set wsMASTER = .Sheets("SUMMARY - CONTRACTORS")                    'sheet with names
    Set wsTEMP = .Sheets("Template")                            'sheet to be copied


'-----------------------

ActiveSheet.wsMASTER.Unprotect = "a"  'Change "a" with ur Password Protected Sheets("Template")
ActiveSheet.wsTEMP.Unprotect = "a"  'Change "a" with ur Password Protected Sheets("SUMMARY - CONTRACTORS")

'-----------------------


Application.ScreenUpdating = False                              'stops the screen updating and make the code run faster

With ThisWorkbook                                               'keep focus in this workbook



    wasVISIBLE = (wsTEMP.Visible = xlSheetVisible)              'check if it's hidden or not

    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetVisible      'make it visible


                                                                'range to find names to be checked

    Set shNAMES = wsMASTER.Range("B4:B153").SpecialCells(xlConstants)     'or xlFormulas

 

    For Each Nm In shNAMES                                      'check one name at a time

        NmSTR = FixStringForSheetName(CStr(Nm.Text))            'use UDF to create a legal sheetname

        If Not Evaluate("ISREF('" & NmSTR & "'!A1)") And wsMASTER.Range("G" & Nm.Row).Value = "Proceed" Then       'if sheet does not exist and pre-requisite is proceed...

            wsTEMP.Copy After:=Sheets("Ranking")                 '...create it from template

            ActiveSheet.Name = NmSTR                            '...rename it

        End If

    Next Nm

 

    'orders the sheets the same as they appear on the summary page

   Dim MasterOrder As Collection

    Set MasterOrder = New Collection

 

    On Error Resume Next

    For Each Nm In shNAMES                                      'checks one name at a time

        MasterOrder.Add Sheets(Nm.Value), CStr(Nm.Value)        'checks where those sheets are in the master list

        Next Nm

        On Error GoTo 0

        Dim i As Long

        For i = 1 To MasterOrder.Count                                      'puts new sheets into a new collection

            Sheets(MasterOrder(i).Name).Move After:=Sheets(.Sheets.Count)   'moves the sheets to the end of all other sheets in order they appear on the summary page

        Next i

    

    wsMASTER.Activate                                           'return to the master sheet

    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetHidden       'hide the template if necessary

    Application.ScreenUpdating = True                           'update screen one time at the end

End With


'-----------------------

ActiveSheet.wsMASTER.Protect = "a"  'Change "a" with ur Password Protected Sheets("Template")
ActiveSheet.wsTEMP.Protect = "a"  'Change "a" with ur Password Protected Sheets("SUMMARY - CONTRACTORS")

'-----------------------



End Sub



Function FixStringForSheetName(shSTR As String) As String



'replace each forbidden character with something acceptable

    shSTR = Replace(shSTR, ":", "")

    shSTR = Replace(shSTR, "?", "")

    shSTR = Replace(shSTR, "*", "")

    shSTR = Replace(shSTR, "/", "-")

    shSTR = Replace(shSTR, "\", "-")

    shSTR = Replace(shSTR, "[", "(")

    shSTR = Replace(shSTR, "]", ")")



'sheet names can only be 31 characters

    FixStringForSheetName = Trim(Left(shSTR, 31))



End Function
Click to expand...
I thought about doing this but I can see in the future someone running into a problem when they change the password and don't update the VBA/ don't know how to 😂
 
Upvote 0
SunnyAlv said:
above and below I added the formula for Protect & Unprotect Sheets, and u just change "a" with the password protected each sheets


VBA Code: 
Option Explicit

Sub EvalSheetSummaryContractor()



'Create copies of a template sheet using text on a master sheet in a specific column

Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wasVISIBLE As Boolean

Dim shNAMES As Range, Nm As Range, NmSTR As String


    Set wsMASTER = .Sheets("SUMMARY - CONTRACTORS")                    'sheet with names
    Set wsTEMP = .Sheets("Template")                            'sheet to be copied


'-----------------------

ActiveSheet.wsMASTER.Unprotect = "a"  'Change "a" with ur Password Protected Sheets("Template")
ActiveSheet.wsTEMP.Unprotect = "a"  'Change "a" with ur Password Protected Sheets("SUMMARY - CONTRACTORS")

'-----------------------


Application.ScreenUpdating = False                              'stops the screen updating and make the code run faster

With ThisWorkbook                                               'keep focus in this workbook



    wasVISIBLE = (wsTEMP.Visible = xlSheetVisible)              'check if it's hidden or not

    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetVisible      'make it visible


                                                                'range to find names to be checked

    Set shNAMES = wsMASTER.Range("B4:B153").SpecialCells(xlConstants)     'or xlFormulas

 

    For Each Nm In shNAMES                                      'check one name at a time

        NmSTR = FixStringForSheetName(CStr(Nm.Text))            'use UDF to create a legal sheetname

        If Not Evaluate("ISREF('" & NmSTR & "'!A1)") And wsMASTER.Range("G" & Nm.Row).Value = "Proceed" Then       'if sheet does not exist and pre-requisite is proceed...

            wsTEMP.Copy After:=Sheets("Ranking")                 '...create it from template

            ActiveSheet.Name = NmSTR                            '...rename it

        End If

    Next Nm

 

    'orders the sheets the same as they appear on the summary page

   Dim MasterOrder As Collection

    Set MasterOrder = New Collection

 

    On Error Resume Next

    For Each Nm In shNAMES                                      'checks one name at a time

        MasterOrder.Add Sheets(Nm.Value), CStr(Nm.Value)        'checks where those sheets are in the master list

        Next Nm

        On Error GoTo 0

        Dim i As Long

        For i = 1 To MasterOrder.Count                                      'puts new sheets into a new collection

            Sheets(MasterOrder(i).Name).Move After:=Sheets(.Sheets.Count)   'moves the sheets to the end of all other sheets in order they appear on the summary page

        Next i

    

    wsMASTER.Activate                                           'return to the master sheet

    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetHidden       'hide the template if necessary

    Application.ScreenUpdating = True                           'update screen one time at the end

End With


'-----------------------

ActiveSheet.wsMASTER.Protect = "a"  'Change "a" with ur Password Protected Sheets("Template")
ActiveSheet.wsTEMP.Protect = "a"  'Change "a" with ur Password Protected Sheets("SUMMARY - CONTRACTORS")

'-----------------------



End Sub



Function FixStringForSheetName(shSTR As String) As String



'replace each forbidden character with something acceptable

    shSTR = Replace(shSTR, ":", "")

    shSTR = Replace(shSTR, "?", "")

    shSTR = Replace(shSTR, "*", "")

    shSTR = Replace(shSTR, "/", "-")

    shSTR = Replace(shSTR, "\", "-")

    shSTR = Replace(shSTR, "[", "(")

    shSTR = Replace(shSTR, "]", ")")



'sheet names can only be 31 characters

    FixStringForSheetName = Trim(Left(shSTR, 31))



End Function
Click to expand...
for context the cells in B4:B153 will always just have next or numbers never a formula if that makes a difference. Thanks for your help
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Macro to create new worksheet from a template, using data from a master list.
Replies
7
Views
6K
RIYAS2030
R
X
  • Question Question
Creating Sheets from Column Using Template Sheet and Copy Cells to Created Sheet
2 3
Replies
26
Views
4K
xavier12
X
A
  • Question Question
Generate and name New workbook + move sheets(That have been generated from template) into the workbook
Replies
1
Views
1K
Norie
Norie
BigPaws
  • Question Question
VBA to create new worksheets from a template, populate the new worksheet by copying data from another sheet to specific locations.
Replies
0
Views
196
BigPaws
BigPaws
C
  • Solved
Create Sheets with a cell name and based on a template
Replies
3
Views
909
kevin9999
K

Forum statistics

Threads
1,223,886
Messages
6,175,191
Members
452,616
Latest member
intern444

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top