• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Application.Speech.Speak not working

Frncis

Member
I have used Application.Speech.Speak in the current application & it has always worked. This batch of code does not work & I am at a loss for a reason. I don't see anything wrong, I am hoping that the brains here, find the problem. Here is the line of non-working code.
Application.Speech.Speak "Click. Vocational Asstistance. Update Button. and verify that the name was entered. If it was entered. Click yes. for the appropriate service. ", SpeakAsync:=True

The other part of the code does work. Here is the entire code:
Code:
Option Explicit
' The user is notified to take appropriate action, when VR is entered in column N.
    Set KeyCells = Range("N3:N329")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
           
    Application.Speech.Speak "Click. Vocational Asstistance. Update Button. and verify that the name was entered. If it was entered. Click yes. for the appropriate service.  ", SpeakAsync:=True
         Application.Wait (Now + TimeValue("00:00:1"))
   VBA.MsgBox "Click Voc Asst Update Button, & verify that name was entered. If entered, Click yes for the appropriate service.", vbOKOnly + vbInformation, _
                       "Vocational Services Reminder"
                       Worksheets("VOC_ASST").Select
                       'Finds the next empty cell in Name column.
                       Worksheets("VOC_ASST").Select
                         ActiveSheet.Range("A4:A296").Find("").Select
    Exit Sub
   End If
        End Sub
 
First ... you don't have a Sub Name at the top of your macro. I presume that was a copy/paste error ?

In any case, this works here :

Code:
Option Explicit

Sub talk()
Dim KeyCells As Range
' The user is notified to take appropriate action, when VR is entered in column N.
    Set KeyCells = Range("N3:N329")

If Not KeyCells Is Nothing Then
           
    Application.Speech.Speak "Click. Vocational Asstistance. Update Button. and verify that the name was entered. If it was entered. Click yes. for the appropriate service.  ", SpeakAsync:=True
         Application.Wait (Now + TimeValue("00:00:1"))
   VBA.MsgBox "Click Voc Asst Update Button, & verify that name was entered. If entered, Click yes for the appropriate service.", vbOKOnly + vbInformation, _
                       "Vocational Services Reminder"
                       Worksheets("VOC_ASST").Select
                       'Finds the next empty cell in Name column.
                       Worksheets("VOC_ASST").Select
                         ActiveSheet.Range("A4:A296").Find("").Select
    Exit Sub
   End If
        
End Sub
 
Without any error message, that's nothing to do with VBA but with the computer​
like harware issue, sound level or even Windows so reboot it …​
 
Here is the title: Private Sub Worksheet_Change(ByVal Target As Range) there is other code under the title that also has
Application.Speech.Speak. Those lines do work, The lines related to VR do not work. The lines dealing with VR action do work. It is just
Application.Speech.Speak in this batch that does not work. If you want the entire code I can post it.
 
This works here :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
' The user is notified to take appropriate action, when VR is entered in column N.
    Set KeyCells = Range("N3:N329")

If Not KeyCells Is Nothing Then
          
    Application.Speech.Speak "Click. Vocational Asstistance. Update Button. and verify that the name was entered. If it was entered. Click yes. for the appropriate service.  ", SpeakAsync:=True
         Application.Wait (Now + TimeValue("00:00:1"))
   VBA.MsgBox "Click Voc Asst Update Button, & verify that name was entered. If entered, Click yes for the appropriate service.", vbOKOnly + vbInformation, _
                       "Vocational Services Reminder"
                       Worksheets("VOC_ASST").Select
                       'Finds the next empty cell in Name column.
                       Worksheets("VOC_ASST").Select
                         ActiveSheet.Range("A4:A296").Find("").Select
    Exit Sub
   End If
       
End Sub
 
Last edited by a moderator:
It would probably be helpful if I posted the entire code. When it tested the code you provided, I got " Duplicate declaration in current scope"

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
' This code strips the first 5 of the Social Security.
'You can have only 1 "If Not Intersect" statement. If more, they do not run below this section.
Dim SSNcell As Range
    'Test whether content should be an abbreviated SSN
   'This restricts the area of application of the event handler
   If Not Intersect(Target, Range("SSN")) Is Nothing Then
        'Make sure the program does not trigger a further event
       Application.EnableEvents = False
        'Loop over intersection
       For Each SSNcell In Intersect(Target, Range("SSN"))
            SSNcell.Value = VBA.Right(SSNcell.Value, 4)
        Next
        'Reset
       Application.EnableEvents = True
    End If

' 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
 Application.Speech.Speak "Copy the  Social Security Number directly from C P R S.    The system stips 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

' This works on the row, M when pending is entered, it also opens the users Outlook calendar.
   Set KeyCells = Range("M3:M329")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

 Application.Speech.Speak "If you entered Pending.  Schedule two. appointments on your calendar. The first appointment. is a reminder. to send a contact letter. ( if no response from the Phone call). Use the Red date to the right. The second appointment. is a reminder.  two weeks later. to cancel the consult. if NO response from earlier attempts...      If you have deleted Pending...   Choose the appropriate      answer for the Reason column.. either from the drop down..   or enter another.            If VR was entered in the column to the right of pending, enter nothing in the reason column. , & delete the appointments on the calendar. ", SpeakAsync:=True
       Application.Wait (Now + TimeValue("00:00:1"))
         VBA.MsgBox " If you entered Pending!  Schedule 2 appointments on your calendar." & vbCrLf & _
          "" & vbCrLf & _
          "The first appointment is a reminder to send a contact letter ( if no response from the Phone call). Use the Red date to the right." & vbCrLf & _
          "" & vbCrLf & _
          "The second appointment is a reminder,  2 weeks later to cancel the consult, if NO response from earlier attempts." & vbCrLf & _
          "" & vbCrLf & _
          "" & vbCrLf & _
          "If you have deleted Pending!" & vbCrLf & _
          "" & vbCrLf & _
          "Choose the appropriate answer for the Reason column, either from the drop down, or enter another." & vbCrLf & _
          "" & vbCrLf & _
          "If VR was entered in the column to the right of pending, enter nothing in the reason column, & delete the appointments on the calendar." & vbCrLf & _
          "" & vbCrLf & _
          "The calendar opens automatically! ", vbOKOnly + vbInformation, _
                       "Vocational Services Reminder"
       'Opens Outlook appointment Calendar for initial response to a consult.
        Dim olApp As Object ' Outlook.Application
        Set olApp = CreateObject("Outlook.Application")
        olApp.Session.GetDefaultFolder(9).Display

' The user is notified to take appropriate action, when VR is entered in column N.
   Dim KeyCells As Range
' The user is notified to take appropriate action, when VR is entered in column N.
    Set KeyCells = Range("N3:N329")

If Not KeyCells Is Nothing Then
          
    Application.Speech.Speak "Click. Vocational Asstistance. Update Button. and verify that the name was entered. If it was entered. Click yes. for the appropriate service.  ", SpeakAsync:=True
         Application.Wait (Now + TimeValue("00:00:1"))
   VBA.MsgBox "Click Voc Asst Update Button, & verify that name was entered. If entered, Click yes for the appropriate service.", vbOKOnly + vbInformation, _
                       "Vocational Services Reminder"
                       Worksheets("VOC_ASST").Select
                       'Finds the next empty cell in Name column.
                       Worksheets("VOC_ASST").Select
                         ActiveSheet.Range("A4:A296").Find("").Select
    Exit Sub
   End If
      
End If
End Sub
 
.
The macro previously provided functions on its own.

I am not certain of the goal of the other code.
 
The other groups of code that have comments explain what that group does. I.e. ' This code strips the first 5 of the Social Security. I included the entire code, I wanted to show that the portion provided was not the only code under that title. The code provided probably did work on its own. However if you notice, the code in the last response already had a Dim KeyCells As Range, hence this message, "Duplicate declaration in current scope". If there is a way around Dim KeyCells As Range, it should work. I have not been successful in finding a workaround, I was hoping that someone would be able to find a work around.
I really do appreciate all the help that you have provided.
 
Just place a break point to the beginning of the event procedure in order when it's launched​
you can follow the code progress just hitting the F8 key (step by step mode) so you will see where the logic is failing …​
 
I want to thank Logit & Marc L. Logit got me looking at the code & Marc L got me at the developmental file line by line. All it was, was a few words.
Here is the working code that is placed at the sheet code level:
Code:
Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
' The user is notified to take appropriate action, when VR is entered in column N.
    Set KeyCells = Range("N3:N329")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
          
   Application.Speech.Speak "Click. Vocational Asstistance. Update Button. and verify that the name was entered. If it was entered. Click yes. for the appropriate service.", SpeakAsync:=True
         Application.Wait (Now + TimeValue("00:00:1"))
   VBA.MsgBox "Click Voc Asst Update Button, & verify that name was entered. If entered, Click yes for the appropriate service.", vbOKOnly + vbInformation, _
                       "Vocational Services Reminder"
                      
    Exit Sub
   End If
End Sub

This code is located in Module 1:
Code:
Sub Vocational_Assistance_Update()
'Copies names from "Monthly Referals" sheet to "VR" Sheet.
'Prevents duplication of names.
  Dim All As Range, R As Range
  Dim Data
 
  With Sheets("Referrals")
    'Find all VR
    Set All = FindAll(.Range("N:M"), "VR")
    If All Is Nothing Then
      MsgBox "No VR found."
      Exit Sub
    End If
    'Map to column C
    Set All = Intersect(All.EntireRow, .Range("C3:C329"))
    'Get unique names
    Data = UniqueItems(All, vbTextCompare)
  End With
  'Transpose to rows
  Data = WorksheetFunction.Transpose(Data)
  With Sheets("VOC_ASST")
    'Find last column
   Set R = .Cells(4, 1)
    'Write the data
    R.Resize(UBound(Data), 1).Value = Data
  End With
  'Finds the next empty cell in Name column.
  Worksheets("VOC_ASST").Select
   'Finds the next empty cell in Name column.
   ActiveSheet.Range("A2:A329").Find("").Select
 End Sub
Again thank you. I have learned so much from the group.
 
Back
Top