Previous code to select 1 of multiple selections not working

FrancisM

Board Regular
Joined
Apr 12, 2016
Messages
139
I have code to open 1 of multiple folders, depending on the selection. Previously it worked like a charm. Now it hangs on MyFolder. I have no idea what is wrong. I have trouble shot it, & it hangs on the same location. Here is the code:

Code:
Sub Partner_Resources()Dim MyValue
     Dim i As String
     
    'MsgBox prompt:="Continue to Vocational Assistance - Partner Resource Listing?", Title:="Voc. Rehab - OVR Data Entry"
    i = MsgBox("Continue to Vocational Assistance - Partner Resource Listing?", vbYesNo, "Voc. Rehab. - Career Link")
    
    If Not i = vbYes Then Exit Sub
    
    'First message shows in the body of the box, message 2 shows at the top of the box.
    Do
        MyValue = Application.InputBox("Click Ok or Cancel." & vbCrLf & _
                               "1 = USA Jobs Class" & vbCrLf & _
                               "2 = OVR" & vbCrLf & _
                               "3 = Career Link" & vbCrLf & _
                               "4 = YWCA" & vbCrLf & _
                               "5 =" & vbCrLf, "Vocational Services - Career Link   " & ActiveSheet.Name)
        ' Sub messaage box exit.
        If MyValue = False Then
            Exit Sub
        ElseIf (MyValue = 1) Or (MyValue = 2) Or (MyValue = 3) Or (MyValue = 4) Or (MyValue = 5) Then
            Exit Do
        Else
            MsgBox "You have not made a valid entry.  Please try again.", vbInformation, "Vocational Services - Career Link  " & ActiveSheet.Name
        End If
    Loop    'Code to Execute When Condition = value_1
    Select Case MyValue
        Case 1
        
        'Message informs user that the process is running.
        MsgBox "Please wait, while I connect to USA Jobs Class.", vbInformation, "Vocational Services - Career Link   " & ActiveSheet.Name
                     If ActiveSheet.CodeName = "Sheet5" Then
        
                    Else
                       MyFolder = "N:\MHBS\Education and Employment\USA Jobs"
                       ActiveWorkbook.FollowHyperlink MyFolder
                    End If
        'Code to Execute When Condition = value_2
        Case 2
        
        'Message informs user that the process is running.
         MsgBox "Please wait, while I connect to OVR Meeting List.", vbInformation, "Vocational Services - Career Link   " & ActiveSheet.Name
                     If ActiveSheet.CodeName = "Sheet11" Then
    
                    Else
                MyFolder = "N:\MHBS\Education and Employment\OVRMeetingList"
                ActiveWorkbook.FollowHyperlink MyFolder
                    End If
        
        'Code to Execute When Condition = value_3
        Case 3
        
        'Message informs user that the process is running.
        MsgBox "Please wait, while I connect to Pennsylvania Career Link Meeting List.", vbInformation, "Vocational Services - Career Link   " & ActiveSheet.Name
                     If ActiveSheet.CodeName = "Sheet64" Then
            
                    Else
                     MyFolder = "N:\MHBS\Education and Employment\Career Link"
                     ActiveWorkbook.FollowHyperlink MyFolder
                     End If
                     
                     'Code to Execute When Condition = value_4
        Case 4
        
        'Message informs user that the process is running.
        MsgBox "Please wait, while I connect to YWCA Meeting List.", vbInformation, "Vocational Services - Career Link   " & ActiveSheet.Name
                     If ActiveSheet.CodeName = "Sheet64" Then
                     Else
                     MyFolder = "N:\MHBS\Education and Employment\YWCA"
                     ActiveWorkbook.FollowHyperlink MyFolder
                End If
    End Select
End Sub
Please explain what is wrong & how to correct it.
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

Forum statistics

Threads
1,223,575
Messages
6,173,148
Members
452,502
Latest member
PQCurious

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top