Hi Roy. Thanks for the offer. Here's my issue, explained as good as I can. (too much info is better than not enough...I say...LOL).
<Call InputBox2> is activated by ThisWorkbook event on startup,
which has the sole purpose of prompting me to assign a unique password to the
program and an “Alpha code word” to correlate with the password, so I can
respond in case the user forgets it.
Sub Inputbox2()
Dim inbx As String
Dim inbx2 As String
Dim vbCom As Object
Dim wb As Workbook
Dim ans As String
Dim SaveChanges As Boolean
Dim FileName As String
inbx = InputBox("Program the New Password" & vbNewLine & vbNewLine & "DEVELOPER SECTION", _
"Assign Password BOX", "Type Here", 2000, 6000)
'This is for the programmer to insert the password for the program
inbx2 = InputBox("PROGRAM the ALPHA" & vbNewLine & "DEVELOPER SECTION", "ALPHA Box", _
"Type Here", 5000, 6000)
'This is for the programmer to insert the password for the program
Sheets("Default Sheet").Activate
Range("B38").Value = inbx
'This sets the paasword from the developer into the program
Sheets("Sign In").Activate
With Range("A2")
.Value = inbx2
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
With Range("A1")
.Value = "ALPHA"
.Font.Bold = True
End With
MsgBox "Hi, I will delete myself "
ans = MsgBox("DONE" & vbNewLine & vbNewLine & "Password & Alpha set to" _
& vbNewLine & inbx & inbx2 & vbNewLine & vbNewLine & " YES = end and shutdown" _
& vbNewLine & " NO = Continue to app", vbYesNo)
If ans = vbYes Then
FileName = "BondyMT_Alpha_" & Range("A2").Value
'Workbooks.Add
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & FileName
Call DeleteCodeLines
ActiveWorkbook.Save
ActiveWorkbook.Close
Else
Exit Sub
End If
End Sub
It assigns the password – Saves as new name – Deletes code
line <Call InputBox2> from ThisWorkbook – re-saves the program (Therefore
<Call InputBox 2> is gone from the
WorkBook event) – Closes the program.
Option Explicit
Private Sub Workbook_Open()
Application.ScreenUpdating = False
With Sheets("Home Sheet").ComboBox1
.AddItem "Appoint. (change)"
.AddItem "Appoint. (needed)"
.AddItem "Bleeding"
.AddItem "Dizzy Spells"
.AddItem "Flu / Cold"
.AddItem "Getting Better"
.AddItem "Getting Worse"
.AddItem "Headache"
.AddItem "Pain"
.AddItem "Heart Rate"
.AddItem "Pain(Chest)"
.AddItem "Prescription"
.AddItem "Sprain"
.AddItem "Throat Sore"
.AddItem "Vomitting"
.AddItem "Other"
End With
With Sheets("Home Sheet").ComboBox2
.AddItem "Before B-fast"
.AddItem "After B-fast"
.AddItem "Before Lunch"
.AddItem "After Lunch"
.AddItem "Before Supper"
.AddItem "After Supper"
.AddItem "Bedtime"
End With
With Sheets("Default Sheet").ComboBox3
.AddItem "Choose Here"
.AddItem "gmail"
'.AddItem "yahoo"
'.AddItem "outlook"
End With
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Protect "Pamela491", UserInterfaceOnly:=True, DrawingObjects:=True, Contents:=True, Scenarios:=True
Next ws
'This allows the macros to run on protected sheets
'This next block is for developer use when adjusting sheets (to remove password)
'For Each ws In ThisWorkbook.Worksheets
'ws.Unprotect "Pamela491"
'Next ws
Application.ScreenUpdating = True
Sheets("Sign In").Select
'This ensures we start on the header sheet
'Insert Call Inputbox2 below this line
Call Inputbox2
Call Inputbox1
End Sub
The renamed altered program is now sitting in my location
for the user. (Thus InputBox2 is gone)
so <Call InputBox1> is activated for the user to open exactly as planned,
(disabling the sheets until the user confirms that the disclaimer has been read,etc...)
and must use the newly assigned password.
Option Explicit
Sub Inputbox1()
Dim rng1 As String
Dim A1 As String
'Dim rng2 As String
Dim A2 As String
Dim blnSignInAsGuest As Boolean
Dim Answ
Dim xWs As Worksheet
Do Until Len(A1) > 0 And Len(rng1) > 0 And A1 = rng1
'Sets inputBox (A1) to test if it matches (rng1) from Default Sheet
'Also checks input & Password from 'Default sheet' it present
A1 = 0
rng1 = Sheets("Default Sheet").Range("B38").Value
A1 = InputBox("Type in Password" & vbNewLine & "OWNER SECTION" & vbNewLine & vbNewLine & vbNewLine _
& "For Guest with limited access" & vbNewLine & "Just hit ENTER", "PASSWORD SIGN IN BOX", "Type Here", 5300, 3500)
'Sets values for A1 & rng1
If Len(A1) = 0 Then
GoTo Jump1
End If
'If the password A1 is left blank or hit cancel or 'X out' (go to retry or guest limited access)
If A1 = rng1 Then
MsgBox "Welcome you're in With Full Access" _
& vbNewLine & vbNewLine & "AFTER YOU'VE READ THE DISCLAIMER" & vbNewLine & "Feel free to change your passcode" & _
vbNewLine & ">>>>> Just Click OK <<<<<" & vbNewLine & vbNewLine & _
"____THEN_____" & vbNewLine & vbNewLine & "Tap the Default Sheet tab" & vbNewLine & _
"at the bottom of this page"
'Tests if password from InputBox = rng1 and ('Cancel' and 'X' out) has not been hit
Call HideWorksheets
Sheets("Disclaimer").Activate
Range("A1").Select
MsgBox "PLEASE ENSURE THAT YOU READ THE TERMS" & vbNewLine & vbNewLine & _
"Click (OK)" & vbNewLine & "Read the Terms" & vbNewLine & _
"Click the button at the bottom" & vbNewLine & "YAHOO! START YOUR DAY"
Exit Sub
End If
'Exits Sub releasing to full access of program
Jump1:
If A1 <> rng1 Then
Answ = MsgBox("Sorry Password does not match" & vbNewLine & _
"Please hit YES to Re-try" & vbNewLine & "Or hit NO to enter as Guest", vbYesNo)
End If
'If password is false then user has option to retry or go on to limited guest access
blnSignInAsGuest = False
'Sets boolean YesNo to 'NO' value for MsgBox choice at label Jump1: to retry or go on to limited access
If Answ = vbYes Then
GoTo Jump3
End If
'This assigns the 'YES" (decision to retry password) by going to label - Jump 3:
'thus looping back to start to begin the process or trying to sign in
If Answ = vbNo Then
blnSignInAsGuest = True
GoTo Jump2
End If
'This assigns the 'NO' (decision to retry password) to actually sign in as guest at label - Junp2:
'reaching past the Loop command
Jump3:
Loop
'Looping has completed. Either the password has been accepted or
'the user has decided to just sign in as Guest with limited access
Jump2:
If blnSignInAsGuest = True Then
A2 = InputBox("Guest/Physician Entry with limited access", _
"GUEST BOX", "JUST HIT ENTER", 500, 5000)
End If
'Now the user has conceded to sign in as Guest as inputbox (A2) has stated
'If Len(A2) = "" Or StrPtr(A2) > 0 Or A2 = 0 Then
'This line tests that the user can input anything or nothing & hit 'Enter'
Call DeleteSheets
'Call DeleteButtons
'This calls the sub routine that deletes the restricted view sheets
MsgBox "Welcome! You're in" & vbNewLine & "Limited Access" _
& vbNewLine & vbNewLine & ">>>>> Just Click OK <<<<<" & vbNewLine & _
"_______THEN" & vbNewLine & "Tap any of the tabs at the bottom of the sheet", 300, 3000
'This advises that the user in in the limited access area for viewing only
'End If
Sheets("Disclaimer").Activate
Range("A1").Select
MsgBox "Please click OK" & vbNewLine & "Then take a few minutes" & vbNewLine & _
"and read the Disclaimer" & vbNewLine & vbNewLine & "Enjoy your" & vbNewLine & _
"Bondy Medical Tracker"
End Sub
Works Great, but I want the macros to be protected. If I protect the project by:
<Tools><Project Properties><Protection><Lock Properties
for viewing><Password>...It won’t allow me to remove “Call InputBox2”
As you suggested there must be a work-around that I can do.
I’m having trouble with this one. Any help
will be appreciated, as this is one of the very last items to be completed, on
this grueling quest...LOL... that I’ve set out on.
Sorry for the length. I figure if you want you can just ignore what you don't need.
Thanks JimmyB