Subscript Out of Range Error because no ReDim?

Question

Not sure why I am getting this error. Please assist in correcting and also, provide a good explanation for the reason. I have 3 subs (from 2 modules) that call each other sequentially. Is the reason for the error message because the file name from the first sub is declared as a variable in the third sub? See code below:

Module1:

Option Explicit

Sub PRM_1_Report_Save()
'
    Application.ScreenUpdating = False

    Dim PRM_1_New As Workbook ' This is BCRS-PTASKS Unassigned.csv
        Set PRM_1_New = Workbooks("BCRS-PTASKS Unassigned.csv")

    Dim SaveDir1 As String, prmAfn As String
    SaveDir1 = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\PRM Temp Files"
    If Len(Dir(SaveDir1, vbDirectory)) = 0 Then MkDir SaveDir1
    prmAfn = SaveDir1 & "\PRM_1_TEMP"
    Application.SendKeys ("~")
    PRM_1_New.SaveAs Filename:=prmAfn, FileFormat:=xlOpenXMLWorkbook

    PRM_1_New.Close False

    Call PRM_2_Report_Save

    Application.ScreenUpdating = True

End Sub

Sub PRM_2_Report_Save()
'
    Application.ScreenUpdating = False

    Dim PRM_2_New As Workbook ' This is Problem WGM & WGL xref with description.xls
        Set PRM_2_New = Workbooks("Problem WGM & WGL xref with description.xls")

    Dim SaveDir2 As String, prmBfn As String
    SaveDir2 = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\PRM Temp Files"
    If Len(Dir(SaveDir2, vbDirectory)) = 0 Then MkDir SaveDir2
    prmBfn = SaveDir2 & "\PRM_2_TEMP"
    Application.SendKeys ("~")
    PRM_2_New.SaveAs Filename:=prmBfn, FileFormat:=xlOpenXMLWorkbook

    PRM_2_New.Close False

    Application.ScreenUpdating = True

    Call Open_PRM_Files

End Sub

Module 2:

Option Explicit

Sub Open_PRM_Files()
'
    Application.ScreenUpdating = False

    Dim PRM_Dir As String
    Dim PRM_1_TEMP As Workbook
        Set PRM_1_TEMP = Workbooks("PRM_1_TEMP.xlsx") ' This is the line that get's the error
    Dim PRM_2_TEMP As Workbook
        Set PRM_2_TEMP = Workbooks("PRM_2_TEMP.xlsx")

        PRM_Dir = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\PRM Temp Files"

        Workbooks.Open Filename:=PRM_Dir & "\" & PRM_1_TEMP
        Workbooks.Open Filename:=PRM_Dir & "\" & PRM_2_TEMP

    Application.ScreenUpdating = True

End Sub

This line from the sub in Module2 is where the debugger shows the error (which is also commented in the sub above):

Set PRM_1_TEMP = Workbooks("PRM_1_TEMP.xlsx")

The purpose of the code here is to save two imported reports into .xlsx format, close them, and then open the files in the saved format. I need this to occur in separate subs (save and open) for other workflow processes of this VBA Project not listed (or relevant) here.

EDIT: I should also mention that the first two subs execute and provide the intended results which is each file saved in the new directory and with the proper extension.

try workbooks.openinstead , and test if Wb is already opened — Patrick Lepelletier

Swaffle Swaffle · Accepted Answer · 2016-04-28T19:45:40

Set PRM_1_TEMP = Workbooks("PRM_1_TEMP.xlsx")

This line assumes that you already have an open workbook with that name. If Excel does not find an open workbook with that name then you will get a runtime error as you noticed.

I'm assuming that you are trying to open the workbooks here which you created in the first two subs:

    Workbooks.Open Filename:=PRM_Dir & "\" & PRM_1_TEMP
    Workbooks.Open Filename:=PRM_Dir & "\" & PRM_2_TEMP

"& PRM_1_TEMP" is the name of a Workbook variable, and you're trying to concatenate it as a string name. Change this to a string matching the filename, and then move your declarations of workbooks to below the code that opens the workbooks. This way Excel opens the workbooks BEFORE trying to access them in the Workbooks collection, and you should not receive an error. I haven't tested this modification, but please let me know if it works for you.

Sub Open_PRM_Files()

    Application.ScreenUpdating = False

    Dim PRM_Dir As String

    PRM_Dir = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\PRM Temp Files"

    Workbooks.Open Filename:=PRM_Dir & "\" & "PRM_1_TEMP"
    Workbooks.Open Filename:=PRM_Dir & "\" & "PRM_2_TEMP"

    Dim PRM_1_TEMP As Workbook
    Set PRM_1_TEMP = Workbooks("PRM_1_TEMP.xlsx") ' This is the line that get's the error
    Dim PRM_2_TEMP As Workbook
    Set PRM_2_TEMP = Workbooks("PRM_2_TEMP.xlsx")
    Application.ScreenUpdating = True

End Sub

Subscript Out of Range Error because no ReDim?

1 Answers