Posts by FrankM

Option Explicit
Sub Admin()
Dim strPassTry As String
Dim strPassword As String
Dim lTries As Long
Dim bSuccess As Boolean

strPassword = "Password" 'Change to you own password
   For lTries = 1 To 3 'Change the number of tries to what ever you want.
    strPassTry = InputBox("Enter Password Please", "Administrative Access Only!")
        If strPassTry = vbNullString Then Exit Sub
        bSuccess = strPassword = strPassTry
        If bSuccess = True Then Exit For
         Application.Speech.Speak "   HEY!!!   You have not made a valid entry.  Please try again.  ", SpeakAsync:=True
            Application.Wait (Now + TimeValue("00:00:06"))
        MsgBox "Password Incorrect!!" & vbNewLine _
        & vbNewLine & "Please enter correct Password!!!" & vbNewLine _
        & vbNewLine & "Or ask for administrative assistance!!!"
    Next lTries
 
    If bSuccess = True Then
    Application.VBE.MainWindow.Visible = True
    End If
End Sub

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' This works in the row that contains names.
      Dim KeyCells As Range
' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("C3:C329")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
       
        ActiveCell.Offset(0, 1).End(xlUp).Select
 Application.Speech.Speak "Copy the  Social Security Number directly from C P R S.    The system strips the first five numbers.  ", SpeakAsync:=True
       Application.Wait (Now + TimeValue("00:00:2"))
     MsgBox " Copy the Social Security Number directly from CPRS. The system strips the first five numbers.  ", vbInformation, "Vocational Services Database - " & ActiveSheet.Name
     
ActiveCell.Offset(1, 0).Select
    Else
   End If
End Sub

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' This works in the row that contains names.
      Dim KeyCells As Range
' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("C3:C329")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
       
        ActiveCell.Offset(0, 1).End(xlUp).Select
 Application.Speech.Speak "Copy the  Social Security Number directly from C P R S.    The system strips the first five numbers.  ", SpeakAsync:=True
       Application.Wait (Now + TimeValue("00:00:2"))
     MsgBox " Copy the Social Security Number directly from CPRS. The system strips the first five numbers.  ", vbInformation, "Vocational Services Database - " & ActiveSheet.Name
     

    Else
   End If
End Sub

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
  'This code reminds the user to add carry over veterans to the current fiscal year roster as a walk in.
        If Not (Application.Intersect(Range("B4:B17"), Target) Is Nothing) Then
    Dim answer As Integer
    answer = MsgBox("Is this veteran a carry over from the previous Fiscal Year?", vbQuestion + vbYesNo + vbDefaultButton2, ThisWorkbook.Name & "   " & ActiveSheet.Name)
 
  If answer = vbYes Then
    MsgBox "It's critical that veteran data is entered in this Fiscal Year Referrals!! " & vbCrLf & _
    "" & vbCrLf & _
    "Please add the carry over veterans to the new walk in sheet.", vbInformation, ThisWorkbook.Name & "   " & ActiveSheet.Name
     Call Referals
  Else
    Exit Sub
    End If
    End If
End sub

Sub Do_Carryover()
'Reminds the user to enter the carryover name into the current FY listing. ' prevents (prevents modification or deletion of cells code from running)
Dim MsgBoxResult As Long
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("B4:B17")) Is Nothing Then Exit Sub
       MsgBoxResult = MsgBox("Is the Veteran a a new client to Career Link? " & vbCr, _
       vbYesNo, "Vocational Services - OVR " & ActiveSheet.Name)
       If MsgBoxResult = vbNo Then
       
      MsgBox " Check to verify Veteran data is entered in FY ##  Referrals! " & vbCr & _
                   "" & vbCr & _
                   " It's critical that Veteran data is captured. " & vbCr & _
                   "" & vbCr & _
                   " Please enter the name in walk in list if not on this year's consult list! " & vbCr & _
                   "Do not enter the name on the Walk In list of there is a Consult for this FY! " & vbCr & _
                   "" & vbCr & _
                   " Enter veteran as a walk in, if a carry over from the past FY year, and enter the SC percent! " & vbCr & _
                   "" & vbCr & _
                   " You have entered " & Cells(Target.Row, 2) & " in cell " & Target.Address, vbInformation, "Vocational Services - Career Link" & ActiveSheet.Name
             
                Call Referals 'Calls Referrals folder.
                
       ElseIf MsgBoxResult = vbYes Then
            If WorksheetFunction.CountA(Range("B:B")) <> 0 Then
               MsgBox " Check to verify Veteran data is entered in FY ##  Referrals! " & vbCr & _
                   "" & vbCr & _
                   " It's critical that Veteran data is captured. " & vbCr & _
                   "" & vbCr & _
                   " Please enter the name in walk in list if not on this year's consult list! " & vbCr & _
                   "Do not enter the name on the Walk In list of there is a Consult for this FY! " & vbCr & _
                   "" & vbCr & _
                   " Enter veteran as a walk in, if a carry over from the past FY year, and enter the SC percent! " & vbCr & _
                   "" & vbCr & _
                   " You have entered " & Cells(Target.Row, 2) & " in cell " & Target.Address, vbInformation, "Vocational Services - Career Link" & ActiveSheet.Name
             
                Call Referals 'Calls Referrals folder.
            Else
                Exit Sub
    End Sub

 'This code prevents modification or deletion of cells in the range below.
        'Does not run when If Target.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub runs (top of code)
        'Does not run when 'Reminds the user to enter the carryover name into the current FY listing is activated (3rd batch of code commented out)
        If Intersect(Target, Range("A2:T3,A21:C23,B11:T12,A18:B18,B32:M50,C18:F18,D21:F21,D23:F24,E20:F20,F22,D4:D17,D21,D23:F24,E20:F20:F24,D21:F21,F18,F20:F22,G18:F18,G18:J18,K18:M19,B63:M81,E87:P90,N4:N10,N13:N17,AI2:AJ3,AI4:AI10,AI13:AI17,AW1")) Is Nothing Then Exit Sub
        On Error GoTo ExitPoint
        Application.EnableEvents = False
        If Not IsDate(Target(1)) Then
        Application.Undo
        
        'Informs user that the cell that they clicked is locked.
            Application.Speech.Speak "You can't delete  or   modify cell contents  in this range. It is  locked.", SpeakAsync:=True
            Application.Wait (Now + TimeValue("00:00:01"))
        MsgBox " You can't delete or modify cell contents in this range " _
        , vbCritical, "Vocational Services - Career Link   " & ActiveSheet.Name
    End If
ExitPoint:
    Application.EnableEvents = True
   
  End Sub
The type mismatch code is commented in the sample, the problem codes are also  commented. I can't figure out what is wrong, because the codes do run separately.  I believe that there is some code syntax or something that I am not aware of.