how-to-fix-the-runtime-error-9-subscript-out-of-range

[Rollnation]

Hello all,

I am trying to import data from a network file to update a dashboard. My VBA retreives the data a brings it into a new workbook but then when my code attempts to copy and paste in into my forecasting model i receive a runtime error 9 "subscript out of range".

I want to declare the active workboook as wbData in the event the user changes the file name...

The error occurs at 'copy and paste historical units which is commented out.

I can upload the workbook im trying to copy if it helps. Any asssitance is truly appreciated!!!!

Code:

Option Explicit


Sub ImportData()


Dim directory As String
Dim fileName As String
Dim wbData As String
Dim sheet As Worksheet
Dim lastRowUnits As Variant
Dim lastRowEDAP As Variant


directory = "K:\CODE 150\COST\RevForecastTool\ImportData"
fileName = Dir(directory & "*.xl??")
wbData = Dir("*.xl??")


'Turn off screen updating and display alerts
Application.ScreenUpdating = False
Application.DisplayAlerts = False


'change directory
ChDrive directory
ChDir directory


'Open filepat,selected Historical Workbook and clear prior data from Import Worksheets
fileName = Application.GetOpenFilename(MultiSelect:=False)
'if user cancels
If fileName = "False" Or fileName = "" Then
Exit Sub
Else:
Workbooks("RevForecast_Beta1.0.xlsm").Sheets("Imp_Units").Range("A34:Z77").ClearContents
Workbooks("RevForecast_Beta1.0.xlsm").Sheets("Imp_EDAP").Range("A16:BZ60").ClearContents
Workbooks("RevForecast_Beta1.0.xlsm").Sheets("Imp_Rev").Range("A11:Z55").ClearContents
Workbooks.Open (fileName)
End If

'Copy and paste Historical Units
'lastRowUnits = Workbooks(wbData).Sheets("Detail Page_1").Cells(Rows.Count, 1).End(xlUp).Row
'Workbooks(wbData).Sheets("Sheet1").Range("A2:Z" & lastRowUnits).Copy
'Workbooks("RevForecast_Beta1.0.xlsm").Sheets("Imp_Units").Range("A34").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


'Copy and paste Historical EDAP
'lastRowEDAP = Workbooks(wbData).Sheets("Detail Page1_2").Cells(Rows.Count, 1).End(xlUp).Row
'Workbooks(wbData).Sheets("Detail Page1_2").Range("A2:BZ" & lastRowEDAP).Copy
'Workbooks("RevForecast_Beta1.0.xlsm").Sheets("Imp_EDAP").Range("A16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


'Close Historical Data Workbook
'Workbooks(wbData).Close


'Turn on screen updating and display alerts
'Application.ScreenUpdating = True
'Application.DisplayAlerts = True


End Sub

 

[dmt32]

Re: how-to-fix-the-runtime-error-9-subscript-out-of-range PLEASE HELP

Hi,

do the sheet names Detail Page_1 Detail Page1_2 in your code match the names in the workbook?

Dave

 

[Fluff]

Re: how-to-fix-the-runtime-error-9-subscript-out-of-range PLEASE HELP

Another thing to tryis to change

Workbooks(wbData)

to

Workbooks(fileName)

 

[Rollnation]

Re: how-to-fix-the-runtime-error-9-subscript-out-of-range PLEASE HELP

Thank you both for the advice. However I have tried both suggestions to no avail.

The runtime error is occuring at this line of code

'lastRowUnits = Workbooks(wbData).Sheets("Detail Page_1").Cells(Rows.Count, 1).End(xlUp).Row

Any other thoughts?

 

[dmt32]

Re: how-to-fix-the-runtime-error-9-subscript-out-of-range PLEASE HELP

Thank you both for the advice. However I have tried both suggestions to no avail.

The runtime error is occuring at this line of code

'lastRowUnits = Workbooks(wbData).Sheets("Detail Page_1").Cells(Rows.Count, 1).End(xlUp).Row

Any other thoughts?

Following is an untested re-type of your code you can try & see if solves the problem

Sub ImportData()
    Dim directory As String, curDirectory As String
    Dim fileName As Variant
    Dim lastRow As Long
    Dim wbRevForecast_Beta1 As Workbook, wbData As Workbook
    
    
    Set wbRevForecast_Beta1 = ThisWorkbook
    
'******************************************SETTINGS***********************************************************
    
    directory = "K:\CODE 150\COST\RevForecastTool\ImportData"
    fileName = Dir(directory & "*.xl??")
    
    
'*************************************************************************************************************
    


'change directory
    curDirectory = CurDir
    ChDrive directory
    ChDir directory
    
    
'Open filepat,selected Historical Workbook and clear prior data from Import Worksheets
    fileName = Application.GetOpenFilename(MultiSelect:=False)
'if user cancels
    If fileName = False Then GoTo exitsub
    
'Turn off screen updating and display alerts
    With Application
        .ScreenUpdating = False: .DisplayAlerts = False
    End With
    
    With wbRevForecast_Beta1
        .Sheets("Imp_Units").Range("A34:Z77").ClearContents
        .Sheets("Imp_EDAP").Range("A16:BZ60").ClearContents
        .Sheets("Imp_Rev").Range("A11:Z55").ClearContents
    End With
    
    On Error GoTo exitsub
    Set wbData = Workbooks.Open(fileName, False, True)
    
    
'Copy and paste Historical Units
    With wbData.Sheets("Detail Page_1")
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("A2:Z" & lastRow).Copy
    End With
    
    wbRevForecast_Beta1.Sheets("Imp_Units").Range("A34").PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    Application.CutCopyMode = False
'Copy and paste Historical EDAP
    With wbData.Sheets("Detail Page1_2")
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("A2:BZ" & lastRow).Copy
    End With
    
    wbRevForecast_Beta1.Sheets("Imp_EDAP").Range("A16").PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    
'Close Historical Data Workbook
    wbData.Close False
    
exitsub:
'reset directory
    ChDrive curDirectory
    ChDir curDirectory
'Turn on screen updating and display alerts
    With Application
        .ScreenUpdating = True: .DisplayAlerts = True
    End With
'report errors
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Please check code carefully before running as I only spent few moments looking at what you are trying to do. You should adjust as required.


Dave

ALWAYS MAKE A BACKUP WHEN TESTING NEW CODE.

 

[Rollnation]

Thank you! With minimal tinkering your code worked.

I commented out these two things which were causing errors. What were these intended to accomplish?

1.
'change directory
'curDirectory = CurDir

&

2.
exitsub:'reset directory
'ChDrive curDirectory
'ChDir curDirectory
ceSheet As Worksheet
Set SourceSheet = ActiveSheet




This code seems to work:
End With

wbRevForecast_Beta1.Sheets("Imp_Units").Range("A34").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False


'Copy and paste Historical EDAP Electric Demand Avoidance Program Data
With wbData.Sheets("Detail Page1_2")
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A2:BZ" & lastRow).Copy
End With

wbRevForecast_Beta1.Sheets("Imp_EDAP").Range("A16").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

'Copy and paste Historical Revenue Data
With wbData.Sheets("Detail Page2_3")
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A2:Z" & lastRow).Copy
End With

wbRevForecast_Beta1.Sheets("Imp_REV").Range("A11").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False


'Close Historical Data Workbook
wbData.Close False

exitsub:
'reset directory
'ChDrive curDirectory
'ChDir curDirectory
'Turn on screen updating and display alerts
With Application
.ScreenUpdating = True: .DisplayAlerts = True
End With
'report errors
'If Error <> 0 Then MsgBox (Error(Err)), 48, "Error"

MsgBox "Data Import is complete."

End Sub