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

Rollnation

New Member
Joined
Jan 17, 2017
Messages
17
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!!!! :confused:

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
 

Some videos you may like

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,083
Office Version
  1. 2019
Platform
  1. Windows
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,164
Office Version
  1. 365
Platform
  1. Windows
Re: how-to-fix-the-runtime-error-9-subscript-out-of-range PLEASE HELP

Another thing to tryis to change
Code:
Workbooks(wbData)
to
Code:
Workbooks(fileName)
 

Rollnation

New Member
Joined
Jan 17, 2017
Messages
17
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

Well-known Member
Joined
Jul 3, 2012
Messages
6,083
Office Version
  1. 2019
Platform
  1. Windows
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

Code:
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

New Member
Joined
Jan 17, 2017
Messages
17
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
 

Watch MrExcel Video

Forum statistics

Threads
1,108,763
Messages
5,524,751
Members
409,600
Latest member
Dunnowhatfor

This Week's Hot Topics

Top