Make an entire workbook "read only" based on the value in a specific cell

[dsheard2015]

Hello,

I have a very large workbook with approximately 560 worksheets. When the workbook opens, I have a login userform that pops up where the user will enter their username and password. That login info is used to determine which sheets in the workbook can be accessed. All the sheets in the workbook are protected and all sheets have locked and unlocked cells. After the workbook is accessed, the current login username is entered on the master index page in cell 'MASTER INDEX'!AD5.

What I am trying to figure out is how I can make the entire workbook "read only" or non-editable if the name located in 'MASTER INDEX'!AD5 is contained within a named range, "Commander_Login". Obviously, if the name is not in that range then the workbook would need to work as normal.

I'm hoping this is possible. Any help with this is greatly appreciated!

Thanks,

Dave

 

[Jaafar Tribak]

I have another idea... how about having code to (silently) prevent unauthorised users (whose names are in Cell AD5) from saving any changes they make to the workbook ? This way, you will not have to worry about editing your existing code plus you won't have the annoying and confusing msgbox prompting the users on saving or closing.

Delete any username that you may currently have in Cell AD5 , place the following code in the ThisWorkbook Module and save :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If IsNameWithinRange(Range("'MASTER INDEX'!AD5"), Range("Commander_Login")) Then
        Cancel = True
    End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If IsNameWithinRange(Range("'MASTER INDEX'!AD5"), Range("Commander_Login")) Then
        Me.Saved = True
    End If
End Sub

Private Function IsNameWithinRange(ByVal TheName As String, ByVal TheRange As Range) As Boolean

    On Error Resume Next
    IsNameWithinRange = CBool(Application.WorksheetFunction.Match(TheName, TheRange, 0))
    
End Function

 

[dsheard2015]

Hello Jaafar,

Thanks for the code, it seems to be working fine. I came across something while working with this workbook and need to modify the code you gave me to work in numerous sheets.

Instead of searching 'MASTER INDEX'!AD5 and looking for it within named range "Commander_Login" how would I write this scenario into code: If cell P2 is within named range "Commander_Login" then ....(the rest of my code)?

Thanks for your help!

Dave

 

[Jaafar Tribak]

If I understand coreectly, if cell p2 is also in the MASTER INDEX worksheet then you could do something like this :

If IsNameWithinRange(Range("'MASTER INDEX'!P2"), Range("Commander_Login")) Then
[COLOR=#006400][B]        'rest of your code goes here ....[/B][/COLOR]
End If

If P2 is in another sheet then just replace MASTER INDEX with the name of that other sheet.

 

[dsheard2015]

Jaafar,

Correct, P2 is not in the master index sheet. So does this IF statement get written into the worksheet code or into a module?

Thanks,

Dave

 

[dsheard2015]

Jaafar,

I will attach the code for this specific worksheet.

I tried entering your code into it, highlighted in red, but I get an error runtime error 1004; application-defined or object defined error.

the worksheet name is "AQC-Form 34-6 (1)"

Since this code is added to the worksheet code can I just have "P2" instead of the entire worksheet name and cell? I ask this because I will need to add this same code to many other sheets and each sheet is named differently with each having a different cell reference also.

Thanks,

Dave

Private Sub Worksheet_Activate()


Dim rLockable As Range
Dim cl As Range
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rng4 As Range
Dim rng5 As Range
Dim rng6 As Range
Dim rng7 As Range
Dim rng8 As Range
Dim rng9 As Range
Dim rng10 As Range
Dim aer As AllowEditRange
Dim sh As Worksheet


On Error Resume Next
On Error GoTo 0


Set sh = ThisWorkbook.ActiveSheet
Set rng1 = ActiveSheet.Range("C28:L28, C61:L61, C94:L94, C127:L127, C160:L160, C193:L193, C226:L226")
Set rng2 = ActiveSheet.Range("C29:L29, C62:L62, C95:L95, C128:L128, C161:L161, C194:L194, C227:L227")
Set rng3 = ActiveSheet.Range("C12:L13, C15:L15, C17:L17, C19:L19, C21:L21, C23:L23, C25:L25")
Set rng4 = ActiveSheet.Range("C45:L46, C48:L48, C50:L50, C52:L52, C54:L54, C56:L56, C58:L58")
Set rng5 = ActiveSheet.Range("C78:L79, C81:L81, C83:L83, C85:L85, C87:L87, C89:L89, C91:L91")
Set rng6 = ActiveSheet.Range("C111:L112, C114:L114, C116:L116, C118:L118, C120:L120, C122:L122, C124:L124")
Set rng7 = ActiveSheet.Range("C144:L145, C147:L147, C149:L149, C151:L151, C153:L153, C155:L155, C157:L157")
Set rng8 = ActiveSheet.Range("C177:L178, C180:L180, C182:L182, C184:L184, C186:L186, C188:L188, C190:L190")
Set rng9 = ActiveSheet.Range("C210:L211, C213:L213, C215:L215, C217:L217, C219:L219, C221:L221, C223:L223")
Set rng10 = ActiveSheet.Range("C11:L25, C27:L27, C30:L30, C44:L58, C60:L60, C63:L63, C77:L91, C93:L93, C94:L94, C110:L124, C126:L126, C129:L129, C143:L157, C159:L159, C162:L162, C176:L190, C192:L192, C195:L195, C209:L223, C225:L225, C226:L226")


ActiveSheet.Unprotect Password:=Sheets("Worksheet Names").Range("O12").Value


[COLOR=#ff0000]    If IsNameWithinRange(Range("'AQC-Form 34-6 (1)'!P2"), Range("Commander_Login")) Then[/COLOR]
[COLOR=#ff0000]        rng10.Locked = True[/COLOR]
[COLOR=#ff0000]    End If[/COLOR]
    
        rng3.Locked = True
        rng4.Locked = True
        rng5.Locked = True
        rng6.Locked = True
        rng7.Locked = True
        rng8.Locked = True
        rng9.Locked = True
        
    For Each aer In ActiveSheet.Protection.AllowEditRanges
    aer.Delete
    Next aer


    ActiveSheet.Protection.AllowEditRanges.Add Title:="Grade", Range:=Range("C28:L28,C61:L61,C94:L94,C127:L127,C160:L160,C193:L193,C226:L226"), Password:=Sheets("Worksheet Names").Range("O27").Value
    ActiveSheet.Protection.AllowEditRanges.Add Title:="Student Initials", Range:=Range("C29:L29,C62:L62,C95:L95,C128:L128,C161:L161,C194:L194,C227:L227"), Password:=Sheets("Worksheet Names").Range("O27").Value


ActiveSheet.Protect Password:=Sheets("Worksheet Names").Range("O12").Value


End Sub
Private Sub Worksheet_Change(ByVal Target As Range)


Dim rLockable As Range
Dim cl As Range


Set rLockable = Range("C28:L28, C61:L61, C94:L94, C127:L127, C160:L160, C193:L193, C226:L226, C29:L29, C62:L62, C95:L95, C128:L128, C161:L161, C194:L194, C227:L227")


'If target is within the range then do nothing
If Intersect(rLockable, Target) Is Nothing Then Exit Sub


ActiveSheet.Unprotect Password:=Sheets("Worksheet Names").Range("O12").Value


For Each cl In Target
    If cl.Value <> "" Then


        check = MsgBox("Please review your entry and select YES if it is correct or NO if it is incorrect.  Once confirmed YES, this cell becomes locked and will require an admin password to unlock it for modification.", vbYesNo, "Cell Lock Notification")
            
            If check = vbYes Then
                cl.Locked = True
                ActiveCell.Offset(2, 0).Select
                    Else
                        cl.Value = ""
            End If
    End If
Next cl


ActiveSheet.Protect Password:=Sheets("Worksheet Names").Range("O12").Value


End Sub

 

[Jaafar Tribak]

You could place the code in a Standard module and then can call the code from every worksheet module by passing to it the corresponding cell as well as the named range .

 

[dsheard2015]

Hello Jaafar,

I have been away from the office for a couple days and not able to respond to your last message. I really like your idea of placing the code in a Standard module and then call the code from every worksheet module by passing to it the corresponding cell as well as the named range however, I don't completely understand which codes to put where.

1. You suggest to "place the code in a standard module". Which code exactly do I put in the standard module since we have passed around a few. If you would please copy that code in your response so I get the correct one. And by standard module you are referring to visual basics, then insert, then module? Correct?

2. You suggest to then "call the code from every worksheet module by passing to it the corresponding cell as well as the named range". I'm guessing that you are saying to add this line of code....

If IsNameWithinRange(Range("'MASTER INDEX'!P2"), Range("Commander_Login")) Then

to the rest of my worksheet code? Would I need to name that worksheet within that code? In the code above the worksheet is MASTER INDEX, so would this new code have that part removed and only leave the cell P2 in place. P2 is the cell that contains the text to search for within the named range "Commander_Login".

I have a total of 4 named ranges that I need to search for P2, each range allows access to different cells on the sheet. The 4 named ranges are "Instructor_Login", "Student_Login", "Commander_Login", and "Miscellaneous_Login". The new line of "IF" code that I am needing would be installed where the 4 red lines of code are found.

I would really appreciate further assistance with getting this finished. I will include the code that is going into that worksheet, would you please modify it the way it needs to be?

Thanks again for all your help!

Dave

Private Sub Worksheet_Activate()
Dim rLockable As Range
Dim cl As Range
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rng4 As Range
Dim rng5 As Range
Dim aer As AllowEditRange
Dim sh As Worksheet
 
Set sh = ThisWorkbook.ActiveSheet
Set rng1 = ActiveSheet.Range("C47, E47, F47, G47, K47, O47, R47, U47")
Set rng2 = ActiveSheet.Range("A1")
Set rng3 = ActiveSheet.Range("A22, T23, A29, T30, A56, T57, A63, T64")
Set rng4 = ActiveSheet.Range("A1")
Set rng5 = ActiveSheet.Range("A1")
 
On Error Resume Next
On Error GoTo 0
 
ActiveSheet.Unprotect Password:=Sheets("Worksheet Names").Range("O12").Value
 
        For Each cl In rng1
               [COLOR=#ff0000] If “P2” is "Instructor_Login" then[/COLOR]
                                elseIf cl.Value = "" Then
                                                cl.Locked = False
                                                Else
                                                cl.Locked = True
                End If
               
                Rng2.locked = True
                Rng3.locked = True
                Rng4.locked = True
                Rng5.locked = True
 
        Next cl
 
        For Each cl In rng2
                [COLOR=#ff0000]If “P2” is "Student_Login" then[/COLOR]
                                elseIf cl.Value = "" Then
                                                cl.Locked = False
                                                Else
                                                cl.Locked = True
                End If
 
                Rng1.locked = True
                Rng3.locked = True
                Rng4.locked = True
                Rng5.locked = True
 
        Next cl
 
        For Each cl In rng3
               [COLOR=#ff0000] If “P2” is "Commander_Login" then[/COLOR]
                                elseIf cl.Value = "" Then
                                                cl.Locked = False
                                                Else
                                                cl.Locked = True
                End If
 
                Rng1.locked = True
                Rng2.locked = True
                Rng4.locked = True
                Rng5.locked = True
 
        Next cl
 
        For Each cl In rng4
                [COLOR=#ff0000]If “P2” is "Miscellaneous_Login" then[/COLOR]
                                elseIf cl.Value = "" Then
                                                cl.Locked = False
                                                Else
                                                cl.Locked = True
                End If
 
                Rng1.locked = True
                Rng2.locked = True
                Rng3.locked = True
                Rng5.locked = True
 
        Next cl
 
ActiveSheet.Protect Password:=Sheets("Worksheet Names").Range("O12").Value
 
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim rLockable As Range
Dim cl As Range
Set rLockable = Range("C47, E47, F47, G47, K47, O47, R47, U47, A22, T23, A29, T30, A56, T57, A63, T64")
'If target is within the range then do nothing
If Intersect(rLockable, Target) Is Nothing Then Exit Sub
 
ActiveSheet.Unprotect Password:=Sheets("Worksheet Names").Range("O12").Value
 
For Each cl In Target
    If cl.Value <> "" Then
 
        check = MsgBox("Please review your entry and select YES if it is correct or NO if it is incorrect.  Once confirmed YES, this cell becomes locked and will require an admin password to unlock it for modification.", vbYesNo, "Cell Lock Notification")

        If check = vbYes Then
                cl.Locked = True
                Else
                                cl.Value = ""
        End If
    End If
                               
Next cl
 
ActiveSheet.Protect Password:=Sheets("Worksheet Names").Range("O12").Value
 
End Sub