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
vbModelessfrom the call button call - 3) Explicitly setting the
ActiveWorkbookto 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
hiddensheet1? Anyway, you must step into the debugger and identify the line where theout of rangeerror occurs.Sheets("hiddensheet1"). You may also try qualifying toThisWorkbook.Sheets("hiddensheet1").