Need to hide sheets until answers are given

[mdjks]

I'm sending out an Excel workbook to get information and want to force respondents to answer the legal questions before they see the rest of the information.

I will send it out with all other tabs hidden but as soon as they answer Yes or No to 17 legal questions I want the tabs visible. Each cell that requires an answer contains the text "Select Y/N" and has Yes No as dropdown choices. My thought was that if the condition Cell <>"Select Y/N" is true then the sheets will appear. I will place a button at the end of the document to click to begin RFP which would give an error message if they have missed an answer or unhide the sheets.

I need help as to the best method to use and the syntax for the code behind it.

Thank you in advance for any help you can provide, I have to send this out this afternoon so...

 

[shades]

Howdy. Here is one approach, probably more than you want, but you could modify.

You see only the Intro worksheet (which would be your question worksheet). Once you fill in the questions, then you can use a button to trigger the unhiding of the appropriate worksheets. On this sample I have the sheets unhidden currently. Hide every except Intro, then login (use AAAA as name and 1111 as password). Obviously your criteria will involve all 17 cells being "Y", so you would change that for unhiding the other worksheets.

Sub UserPassword()
    Dim LastName As String, PassWord As String, myName As String
Application.ScreenUpdating = False
    ActiveWorkbook.Sheets("Admin").Visible = True
    ActiveWorkbook.Sheets("Admin").Activate
    myName = InputBox("Enter Last Name")
'    On Error GoTo Msg
    If myName = "" Then
        ActiveWorkbook.Sheets("Admin").Visible = False
        Exit Sub
    Else
    End If
'Msg:     MsgBox ("Your Name is not listed")

    Sheets("Admin").Range("D2").Value = myName
    
'MsgBox Application.WorksheetFunction.VLookup(Sheets("Passwords").Range("D2").Value, Range("A2:A6"), 1, True)
    If Application.WorksheetFunction.VLookup(Sheets("Admin").Range("D2").Value, Range("A2:A6"), 1, True) = Sheets("Admin").Range("D2").Value Then
        Sheets("Admin").Range("E2").Value = InputBox("Enter Password")
        If Sheets("Admin").Range("E3").Value = Sheets("Admin").Range("E2").Value Then
            Sheets("ShowData").Range("B2").Value = Sheets("Admin").Range("D2").Value
            ActiveWorkbook.Sheets("ShowData").Visible = True
            ActiveWorkbook.Sheets("Intro").Visible = False
            ActiveWorkbook.Sheets("Admin").Visible = False
            ActiveWorkbook.Sheets("ShowData").Select
        Else:
            ActiveWorkbook.Sheets("Admin").Visible = False
            MsgBox ("You have entered wrong Password")
        End If
    Else
        ActiveWorkbook.Sheets("Admin").Visible = False
        MsgBox ("Your Name is not listed")
    End If
'   This calls the next macro for filling in the data
    ViewData
    
Application.ScreenUpdating = True
End Sub


Sub ViewData()
    Dim myName As String
    Dim ABCDList As Range
    Dim JohnsonList As Range
    Dim AAAAList As Range
    Dim BBBBList As Range
    Dim PeterList As Range
    
    myName = Sheets("ShowData").Range("B2").Value
    Select Case myName
        Case "AAAA"
            Sheets("Admin").Range("AAAAList").Copy Sheets("ShowData").Range("B4")
        Case "ABCD"
            Sheets("Admin").Range("ABCDList").Copy Sheets("ShowData").Range("B4")
        Case "BBBB"
            Sheets("Admin").Range("BBBBList").Copy Sheets("ShowData").Range("B4")
        Case "Johnson"
            Sheets("Admin").Range("JohnsonList").Copy Sheets("ShowData").Range("B4")
        Case "Peter"
            Sheets("Admin").Range("PeterList").Copy Sheets("ShowData").Range("B4")
    End Select

End Sub

Sub EndSession()
    Application.ScreenUpdating = False
    On Error Resume Next
    ActiveWorkbook.Sheets("Intro").Visible = True
    ActiveWorkbook.Sheets("ShowData").Range("B2").ClearContents

    Sheets("ShowData").Range("DataList").ClearContents
    ActiveWorkbook.Sheets("ShowData").Visible = False
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

________
HALF-BAKED

 

[mdjks]

Looks like this should work, thanks a million!