none
Run-time err 9 Subscript out of range RRS feed

  • Question

  • Dear Sir:

    I made the following program:

                              

    Sub CreateNewWork()
        Dim WB As Workbook
        Dim sht As Worksheet
        Dim MyPath As String
        Dim Range1 As Range
        Dim range2 As Range

        MyPath = "C:\Users\hushe\Desktop\PG06\PG06-0924-01_2016-09-24_00-01-08.csv"

        Set WB = Workbooks.Add
        With WB
            .SaveAs Filename:="Summary"
            .Sheets(1).Name = "total"
        End With
        Set sht = WB.Worksheets.Add

        With sht
            .Name = "Shell"
        End With
        Range1 = Application.Workbooks(MyPath).Sheets(1).Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
        range2 = sht.Range("B1")
        Range1.Copy range2

        WB.Save
        WB.Close

    End Sub

    When I run it, it shows "Run-time err 9, Subscript out of range". I debuged the problem. It highlighted the following line:Range1 = Application.Workbooks(MyPath).Sheets(1).Range(Range("A1"), Range("A1").SpecialCells(xlLastCell)).

    Would you please help see what is the problem and how to solve this problem? Your support is highly appreciated.

    Regards,

    Shell Hu

    Wednesday, November 9, 2016 11:37 AM

Answers

  • Hello Shell Hu

    There are a several ways to approach this question.

    If you know that the file PG06-0924-01_2016-09-24_00-01-08.csv will always be closed when you run the procedure, then you simply have to open it in your code with something like:

    workbooks.open FileName:= "C:\Users\hushe\Desktop\PG06\PG06-0924-01_2016-09-24_00-01-08.csv"

    However, if you are not sure about the state of the file at run time, then you need code to check whether it is open.  The code below caters for that situation.  You will see that I have removed the variable MyString as being unnecessary.  There is a flag (booOpenFlag) to show whether the .csv file is open or not.

    Sub CreateNewWork()
         Dim WB As Workbook
         Dim sht As Worksheet
         Dim strLC As String 'Last cell in csv workbook
         Dim booOpenFlag As Boolean

    'Find if workbook is open
        For Each WB In Workbooks
            If WB.Name = "PG06-0924-01_2016-09-24_00-01-08.csv" Then
                 booOpenFlag = True
                 Exit For
            End If
        Next WB

    'If workbook is NOT open, open it
        If booOpenFlag = False Then
            Workbooks.Open FileName:="C:\Users\hushe\Desktop\PG06\PG06-0924-01_2016-09-24_00-01-08.csv"
        End If

         Set WB = Workbooks.Add
         With WB
             .SaveAs FileName:="Summary"
             .Sheets(1).Name = "total"
         End With
         Set sht = WB.Worksheets.Add

         With sht
             .Name = "Shell"
         End With

         strLC = Workbooks("PG06-0924-01_2016-09-24_00-01-08.csv").Sheets(1).Cells.SpecialCells(xlCellTypeLastCell).Address(False, False)
         Workbooks("PG06-0924-01_2016-09-24_00-01-08.csv").Activate
         Range("A1:" & strLC).Copy Destination:=Workbooks("Summary.xlsx").Sheets("total").Range("B1")

         WB.Save
         WB.Close

    End Sub

    I hope this helps.  If it answers the question please mark it as an answer so that others with a similar problem can see it as solved.

    Andy C

    • Marked as answer by Shell Hu Thursday, November 10, 2016 8:52 AM
    Thursday, November 10, 2016 8:41 AM

All replies

  • Hello Shell Hu

    Your problem lies with the use of Ranges.  The code below should solve it.

    Sub CreateNewWork()
         Dim WB As Workbook
         Dim sht As Worksheet
         Dim MyPath As String
         Dim strLC As String 'Last cell in MyPath workbook
    
         MyPath = "PG06-0924-01_2016-09-24_00-01-08.csv"
    
         Set WB = Workbooks.Add
         With WB
             .SaveAs FileName:="Summary"
             .Sheets(1).Name = "total"
         End With
         Set sht = WB.Worksheets.Add
    
         With sht
             .Name = "Shell"
         End With
         
         strLC = Workbooks(MyPath).Sheets(1).Cells.SpecialCells(xlCellTypeLastCell).Address(False, False)
         Workbooks(MyPath).Activate
         Range("A1:" & strLC).Copy Destination:=Workbooks("Summary.xlsx").Sheets("total").Range("B1")
    
         WB.Save
         WB.Close
    
     End Sub
    

    I would caution against using xlCellTypeLastCell because, although a cell may appear to be empty, it may in fact contain formatting that is read by VBA as being a used cell.  However, that is not what you asked, and if you are confident that your worksheet does not contain any cells of that type then the code above should work as you expect.

    Andy C

    Wednesday, November 9, 2016 3:52 PM
  • Ranges are objects, so you have to use the Set keyword to assign the range1 and range2 variables. Moreover, when referring to ranges in another sheet/workbook, you have to do that consistently:

        With Workbooks(MyPath).Sheets(1)
            Set Range1 = .Range(.Range("A1"), .Range("A1").SpecialCells(xlLastCell))
        End With
        Set range2 = sht.Range("B1")


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Wednesday, November 9, 2016 3:54 PM
  • Dear Sir:

    When I run VBA as you instructed. I still got the same problem. The highlighted line in debug is "

    strLC = Workbooks(MyPath).Sheets(1).Cells.SpecialCells(xlCellTypeLastCell).Address(False, False)

    "would you please help see if there is another way to solve this probblem?

    Regards,

    Shell Hu

    Thursday, November 10, 2016 12:30 AM
  • Dear Sir:

    The problem is still at the same line.

    Regards,

    Shell Hu

    Thursday, November 10, 2016 12:31 AM
  • Hello Shell Hu

    The code runs correctly when I run it using Office 2016 and Windows 10.  Two things to check:

    1.  Make sure that MyPath is set as in the code I posted, not the full path to the file as in your original.

    2.  Make sure that the file "PG06-0924-01_2016-09-24_00-01-08.csv" is open when you run the procedure and that the name is correct including the file extension (.csv).

    Andy C

    Thursday, November 10, 2016 3:00 AM
  • Dear Sir:

    You are correct! The program you suggested is working when I opened the file. Is there a possible way that this program can run if I don't have to open the file? That's what I want. Your support is highly appreciated!

    Regards,

    Shell Hu

    Thursday, November 10, 2016 3:15 AM
  • Hello Shell Hu

    There are a several ways to approach this question.

    If you know that the file PG06-0924-01_2016-09-24_00-01-08.csv will always be closed when you run the procedure, then you simply have to open it in your code with something like:

    workbooks.open FileName:= "C:\Users\hushe\Desktop\PG06\PG06-0924-01_2016-09-24_00-01-08.csv"

    However, if you are not sure about the state of the file at run time, then you need code to check whether it is open.  The code below caters for that situation.  You will see that I have removed the variable MyString as being unnecessary.  There is a flag (booOpenFlag) to show whether the .csv file is open or not.

    Sub CreateNewWork()
         Dim WB As Workbook
         Dim sht As Worksheet
         Dim strLC As String 'Last cell in csv workbook
         Dim booOpenFlag As Boolean

    'Find if workbook is open
        For Each WB In Workbooks
            If WB.Name = "PG06-0924-01_2016-09-24_00-01-08.csv" Then
                 booOpenFlag = True
                 Exit For
            End If
        Next WB

    'If workbook is NOT open, open it
        If booOpenFlag = False Then
            Workbooks.Open FileName:="C:\Users\hushe\Desktop\PG06\PG06-0924-01_2016-09-24_00-01-08.csv"
        End If

         Set WB = Workbooks.Add
         With WB
             .SaveAs FileName:="Summary"
             .Sheets(1).Name = "total"
         End With
         Set sht = WB.Worksheets.Add

         With sht
             .Name = "Shell"
         End With

         strLC = Workbooks("PG06-0924-01_2016-09-24_00-01-08.csv").Sheets(1).Cells.SpecialCells(xlCellTypeLastCell).Address(False, False)
         Workbooks("PG06-0924-01_2016-09-24_00-01-08.csv").Activate
         Range("A1:" & strLC).Copy Destination:=Workbooks("Summary.xlsx").Sheets("total").Range("B1")

         WB.Save
         WB.Close

    End Sub

    I hope this helps.  If it answers the question please mark it as an answer so that others with a similar problem can see it as solved.

    Andy C

    • Marked as answer by Shell Hu Thursday, November 10, 2016 8:52 AM
    Thursday, November 10, 2016 8:41 AM