1

I have a CMD button on my sheet with the following code:

Private Sub cmdBlastoff_Click()
  UserForm2.Show vbModeless           'launch gateway userform
End Sub

This code worked for a long time, but is now generating "Error 9: Subscript out of range."

The userform I am trying to call (UserForm2) is located in the same workbook.

I will put the full code of the userform below in case it's relevant, but the code in its Userform_initialize sub is:

Private Sub userform_initialize()
    Sheets("hiddensheet1").Range("B5").Value = "v7.04"      'sets version # in hidden sheet
    FileNameChecker_local                                   'runs a sub (located below in the userform module) to determine the filename and path
    ValueInjector                                           'runs a sub (located below in the userform module) to put some values into text fields on the userform
    cmdBigGo.Font.Size = 15                                 'sets font size of a button
End Sub

As I said earlier, this was working until recently and I am out of ideas. So far I have tried:

  • 1) Finding some way to explicitly point to the exact location of userform2 by specifying the workbook in front of it: ActiveWorkbook.UserForm2.show (doesn't work for reasons that are now obvious) I regard a more explicit call as the most likely fix, but don't know how to do it
  • 2) Removing vbModeless from the call button call
  • 3) Explicitly setting the ActiveWorkbook to the one all my stuff is stored on, which is where the call button sits (this shouldn't be necessary, I know)

Any other ideas?

Full code of the UserForm2 (probably not relevant, all working prior to this problem arising):

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
    (ByVal pCaller As Long, _
    ByVal szURL As String, _
    ByVal szFileName As String, _
    ByVal dwReserved As Long, _
    ByVal lpfnCB As Long) As Long

'should check to see if there is an output folder in the directory where COGENT sits and if not create it
'should pull default filepath to the outputs folder from the hiddensheet
'should call data baster on terminate
'DONE   should allow the user to change the default save location
'DONE   should allow them to change the save location THIS time.
'DONE   should pull filepath from hiddensheet, check against original (?) and
'DONE   Should create a default filename


    Public strFileFullName As String
    Public strFileJustPath As String
    Public strUserFolderName As String
    Public strFileName As String
    Public strRawDate As String

    Public strDLlink As String
    Public strDLdest As String
    Public strDLlocalName As String
    Public strDLNameOnWeb As String

    Public strOpenURLPointer As String
    Dim strSaveAsErrHandler As String
    Dim strQueryID As String


Private Sub userform_initialize()
    Sheets("hiddensheet1").Range("B5").Value = "v7.04"      'sets version # in hidden sheet
    FileNameChecker_local                                   'runs a sub (located below in the userform module) to determine the filename and path
    ValueInjector                                           'runs a sub (located below in the userform module) to put some values into text fields on the userform
    cmdBigGo.Font.Size = 15                                 'sets font size of a button
End Sub


Private Sub chkCyberDiv_Click()
    If chkCyberDiv.Value = True Then
        '==Cyber OUs visible==
        chkNDIO.Visible = True
        txtQueryID.Value = "169436"

        '==Other Div OUs invisible==
        chkCivilDiv.Value = False
    Else
        chkNDIO.Visible = False
    End If
End Sub
Private Sub chkCivilDiv_Click()
    If chkCivilDiv.Value = True Then
        '==Civil OUs visible==
        chkCivilInfoSys.Visible = True

        '==Other Div OUs invisible==
        chkCyberDiv.Value = False
    Else
        chkCivilInfoSys.Visible = False
    End If
End Sub

Sub cmdBigGo_Click()
    '==========Check if SaveAsNewName worked and if not kill sub==========
        SaveAsNewName
            If strSaveAsErrHandler = "Filename/path not viable." Then
                MsgBox strSaveAsErrHandler
                Exit Sub
            Else
    '==========Startup==========
    Application.ScreenUpdating = False
    Sheets("LoadingData").Visible = True
    Sheets("Launchpad").Visible = False

        '==========Check for/create Temp Directory==========
            If FileFolderExists(strFileJustPath & "\temp") = True Then
                'MsgBox "temp Folder already exists."
            Else
                MkDir strFileJustPath & "\temp"
                'MsgBox "temp Folder didn't exist, but it do now."
            End If

        '==========Download Section==========
            '=====Set up=====                                        'big gap for now =          169436
                strQueryID = txtQueryID.Value
                strDLlink = "https://workbench.northgrum.com/xauth/login.aspx?&ActionPageID=37&ActionParameters=QueryID%3d" & strQueryID & "%26View%3d0%26OutputToExcel%3d1"
                strDLdest = strFileJustPath & "\temp\dump.xlsx"

            '=====Run=====
                'MsgBox "cmdBigGo thinks strDLdest = " & strDLdest
                Dim done
                done = URLDownloadToFile(0, strDLlink, strDLdest, 0, 0)

    '==========Copy Targets from temp file==========
         Sheets("LoadingData").Select
         copyPathName = strFileJustPath & "\temp\"
         copyFileName = "dump.xlsx"
         copyTabName = "Targets"
         ControlFile = ActiveWorkbook.Name
         Workbooks.Open FileName:=copyPathName & "\" & copyFileName
         ActiveSheet.Name = copyTabName
         Sheets(copyTabName).Copy After:=Workbooks(ControlFile).Sheets(1)
         Windows(copyFileName).Activate
         ActiveWorkbook.Close SaveChanges:=False
         Windows(ControlFile).Activate
         ActiveWorkbook.Sheets("Targets").Name = "COGENT Targets"
         '^source: https://msdn.microsoft.com/en-us/library/office/ff194819.aspx

    '==========Delete Temp Directory==========
         On Error Resume Next
         Kill copyPathName & "\*.*"    ' delete all files in the folder
         RmDir copyPathName  ' delete folder
         On Error GoTo 0

    '==========Create Userform1 Button on "Targets"==========
        Rows("1:1").RowHeight = 26
        Dim btnCOGENT As Button
        Set btnCOGENT = Sheets("COGENT Targets").Buttons.Add(10.5, 4.5, 84.75, 19.5)
        With btnCOGENT
            .OnAction = "CallUserform1"
            .Characters.Text = "COGENT"
        End With
        With btnCOGENT.Characters(Start:=1, Length:=6).Font
            .Name = "Calibri"
            .FontStyle = "Regular"
            .Size = 11
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = 1
        End With
        Sheets("COGENT Targets").Shapes("Button 1").ScaleWidth 0.7433628319, msoFalse, _
            msoScaleFromTopLeft

    '==========Finish up==========
         Worksheets("COGENT Targets").Activate
         Sheets("LoadingData").Visible = False
         Application.ScreenUpdating = True
    End If
        UserForm1.Show vbModeless
    End Sub

Private Sub SaveAsNewName()

    strSaveAsErrHandler = ""
    On Error GoTo ErrorHandler

    '==========Save the file with a new name==========
        Dim strExpectedFileFullName As String
        strExpectedFileFullName = txtFilePath.Value & "\" & txtFileName & ".xlsm"
        ActiveWorkbook.SaveAs strExpectedFileFullName
        FileNameChecker_local                                   'get the new filename

    Exit Sub
ErrorHandler:
    '==========Error Handler==========
    If Err.Number = 1004 Then
        lblSaveAsText.Caption = "That name and location didn't work... Try using 'Browse' or 'Create Outbox."
        lblSaveAsText.BackColor = &H8080FF
        strSaveAsErrHandler = "Filename/path not viable."
    Else
        MsgBox "unknown error...email [email protected]; it's probably his fault."
        strSaveAsErrHandler = ""
    End If

End Sub





Sub FileNameChecker_local()


    '==========Check Filename and SaveAs if needed==========

    strFileJustPath = ActiveWorkbook.Path
    strFileFullName = ActiveWorkbook.FullName

        '==========Get Filename==========
            Dim i As Integer
            Dim intBackSlash As Integer, intPoint As Integer
            For i = Len(strFileFullName) To 1 Step -1
              If Mid$(strFileFullName, i, 1) = "." Then
                intPoint = i
                Exit For
              End If
            Next i
            If intPoint = 0 Then intPoint = Len(strFileFullName) + 1
            For i = intPoint - 1 To 1 Step -1
              If Mid$(strFileFullName, i, 1) = "\" Then
                intBackSlash = i
                Exit For
              End If
            Next i
            strFileName = Mid$(strFileFullName, intBackSlash + 1, intPoint - intBackSlash - 1)
           'MsgBox "strFileName = " & strFileName & vbNewLine & _
                    "strFileJustPath = " & strFileJustPath & vbNewLine & _
                    "strFileFullName = " & strFileFullName & vbNewLine & _
                    "ran from userform2"
End Sub
Private Sub ValueInjector()

    strRawDate = Format(Date, "mm-d-yy")

    '==========Inject File Name==========
        If strFileName = "COGENT Launchpad" Then
            txtFileName.Value = "COGENT_Pull_" & strRawDate            'might be better to include query number\
            lblSaveAsText.Caption = "Give your output a descriptive name. Here's a suggestion:"
           Else
            'txtFileName.Value = strFileName
            lblSaveAsText.Caption = "This file should be named 'COGENT Launchpad.' Some features break if you rename it."
            lblSaveAsText.BackColor = &H8080FF
            'MsgBox "Please rename this file 'COGENT Launchpad'"
        End If

    '==========Inject File Path==========
    Application.ScreenUpdating = False
     If IsEmpty(Worksheets("Hiddensheet1").Range("B6")) Then
            cmdCreateOutbox_click
            Worksheets("Hiddensheet1").Range("B6") = strFileJustPath & "\Outbox"
            txtFilePath.Value = Worksheets("Hiddensheet1").Range("B6")
        Else
            txtFilePath.Value = Worksheets("Hiddensheet1").Range("B6")
        End If
    Application.ScreenUpdating = True
    Worksheets("Launchpad").Activate

End Sub


Private Sub cmdBrowse_Click()
    FileNameChecker_local
    GetFolder (strFileJustPath)

End Sub
Private Sub cmdMakeDefault_Click()
    Worksheets("Hiddensheet1").Range("B6") = txtFilePath.Value
    imgCheckMark.Visible = True
End Sub
Private Sub cmdCreateOutbox_click()
    'MsgBox "looking for" & strFileJustPath & "\Outbox"

     If FileFolderExists(strFileJustPath & "\Outbox") Then
        MsgBox "Outbox Folder already exists."
    Else
        MsgBox "Outbox Folder did not exist, but it does now."
        MkDir strFileJustPath & "\Outbox"
        txtFilePath.Value = strFileJustPath & "\Outbox"
    End If

End Sub


Function GetFolder(strFilePath As String) As String

    Dim fldr As FileDialog
    Dim strGetFolderOutput As String

    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)

    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strFilePath
        If .Show <> -1 Then GoTo NextCode
        strGetFolderOutput = .SelectedItems(1)
    End With
NextCode:
    GetFolder = strGetFolderOutput
    txtFilePath.Value = strGetFolderOutput
    Set fldr = Nothing
End Function


Private Sub userform_terminate()
    Unload Me
End Sub
3
  • 1
    Did you verify the existence of hiddensheet1? Anyway, you must step into the debugger and identify the line where the out of range error occurs. Commented Nov 10, 2015 at 17:30
  • Yep, step through this line by line using F8 in debugging mode, and you'll probably see that it's not the UserForm itself which is "out of range", but rather some other named parameter, like Sheets("hiddensheet1"). You may also try qualifying to ThisWorkbook.Sheets("hiddensheet1"). Commented Nov 10, 2015 at 17:33
  • I'll be derned; yall are right. Somehow the hidden sheet got deleted, and it gets referred to before I check its existence and create it if missing. Thanks guys; I was barking up totally the wrong tree. Fixed and working. Commented Nov 10, 2015 at 21:24

1 Answer 1

0

Somehow the hidden sheet got deleted, and it gets referred to before I check its existence and create it if missing. Thanks guys; I was barking up totally the wrong tree. Fixed and working.

Nothing was wrong with the calling of the userform at all.

Sign up to request clarification or add additional context in comments.

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.