none
VBA Excel - Subscript out of range

    Question

  • Hey guys,

    I'm working on the below code as a free time project at my work. I want it to do the following when I click the sub:

    1. Open CET WM.xlsm (Dim'd as wb1)
    2. Set the value of K1 (on the "Raw" sheet, in CET WM) to be the number of sheets in the workbook
    3. Posts the sheet names one by one on K2 going downwards
    4. Copies the K column to the designated place in CET Dash.xlsm; which I'll then turn into a dropdown.

    The issues I'm running into :

    1. When I get to the code below is says subscript out of range- on the lines below where I comment "Puts the sheet names in K." I have no idea why.

    2. I don't know how to get "Set wb1 = Workbooks.Open("P:\CET WM.xlsm")" to work if the workbook is already open. It tells me "subscript is out of range" when I remove the .open part of it; and when it's already open it gets stuck at the "this is already open, want to open anyways?" message.

    Anyways, here's the code:

    Private Sub GrabButton_Click()
    
    Dim NumberOfSheets As Integer
    Dim N As Integer
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim RawSheet As Worksheet
    Dim UglySheet As Worksheet
    N = 2
    
    If wb1 Is Nothing Then
            Set wb1 = Workbooks.Open("P:\CET WM.xlsm")
            Set RawSheet = wb1.Sheets("Raw")
        End If
    
    If wb2 Is Nothing Then
            Set wb2 = Workbooks.Open("P:\CET Dash.xlsm")
            Set UglySheet = wb2.Sheets("Ugly")
        End If
    
    'Opens CET WM and puts the number of sheets in K1, defines NumberOfSheets as the K1 value.
    RawSheet.Activate
    Range("K2").Value = wb1.Sheets.Count
    NumberOfSheets = Range("K2").Value
    
    'Puts the sheet names in K.
    Do
        RawSheet.Range("K2").Select
        Selection.Offset(N, 0).Select
        ActiveCell.Value = Sheets(N).Name
        N = N + 1
    Loop Until N = NumberOfSheets - 2
    
    'Copies the sheet names from CET WM and pastes them to CET Dash.
    Range(K).Copy
    UglySheet.Activate
    ActiveSheet.Range("B1").Select
    Selection.End(xlDown).Offset(1, 0).Paste
    
    End Sub

    Tuesday, December 18, 2012 11:32 AM

Answers

  • Try

    UglySheet.Paste Destination:=UglySheet.Range("B1")


    Regards, Hans Vogelaar

    • Marked as answer by NathanaelB Thursday, December 20, 2012 5:57 AM
    Wednesday, December 19, 2012 1:13 PM

All replies

  • Try this version:

    Private Sub GrabButton_Click()
        Dim NumberOfSheets As Integer
        Dim N As Integer
        Dim wb1 As Workbook
        Dim wb2 As Workbook
        Dim RawSheet As Worksheet
        Dim UglySheet As Worksheet
    
        On Error Resume Next
        Set wb1 = Workbooks("P:\CET WM.xlsm")
        On Error GoTo 0
        If wb1 Is Nothing Then
            Set wb1 = Workbooks.Open("P:\CET WM.xlsm")
        End If
        Set RawSheet = wb1.Sheets("Raw")
    
        On Error Resume Next
        Set wb2 = Workbooks("P:\CET Dash.xlsm")
        On Error GoTo 0
        If wb2 Is Nothing Then
            Set wb2 = Workbooks.Open("P:\CET Dash.xlsm")
        End If
        Set UglySheet = wb2.Sheets("Ugly")
    
        'Opens CET WM and puts the number of sheets in K2.
        'defines NumberOfSheets as the K2 value.
        NumberOfSheets = wb1.Sheets.Count
        RawSheet.Range("K2").Value = NumberOfSheets
    
        'Puts the sheet names in K.
        For N = 1 To NumberOfSheets
            RawSheet.Range("K" & (N + 2)).Value = wb1.Sheets(N).Name
        Next N
    
        'Copies the sheet names from CET WM and pastes them to CET Dash.
        RawSheet.Range("K3:K" & (NumberOfSheets + 2)).Copy _
            Destination:=UglySheet.Range("B1").End(xlDown).Offset(1, 0)
    End Sub
    


    Regards, Hans Vogelaar

    Tuesday, December 18, 2012 12:47 PM
  • Thanks for the help Hans,

    I tried the code below (which is virtually the same code as the one you told me to use) and I keep getting:

    Run-time error '1004':
    Application-defined or object-defined error

    It highlights the two lines of code below the comment " 'Copies the sheet names from CET WM and pastes them to CET Dash' and breaks there. 

    I also tried : 

    ActiveSheet.Columns("K:K").Copy UglySheet.Range("B1")
    UglySheet.Activate
    ActiveSheet.Range("B1").Selected
    Selection.End(xlDown).Offset(1, 0).Paste

    But it returns:

    Run-time error '438':
    Object doesn't support this property or method

    I've tried to code it to simply target them as ranges and paste them into UglySheet (without offsetting anything) and it gives a similar error.

    Anyways, here's the code I used :

    Private Sub GrabButton_Click()
        
    Dim NumberOfSheets As Integer
    Dim N As Integer
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim RawSheet As Worksheet
    Dim UglySheet As Worksheet
    
    On Error Resume Next
    Set wb1 = Workbooks("C:\CET WM.xlsm")
    On Error GoTo 0
    If wb1 Is Nothing Then
        Set wb1 = Workbooks.Open("C:\CET WM.xlsm")
        End If
    Set RawSheet = wb1.Sheets("Raw")
    
    On Error Resume Next
    Set wb2 = Workbooks("C:\CET Dash.xlsm")
    On Error GoTo 0
    If wb2 Is Nothing Then
        Set wb2 = Workbooks.Open("C:\CET Dash.xlsm")
        End If
    Set UglySheet = wb2.Sheets("Ugly")
        
    'Opens CET Walmart and puts the number of sheets in K1, defines NumberOfSheets as the K1 value.
    NumberOfSheets = wb1.Sheets.Count
    RawSheet.Range("K2").Value = NumberOfSheets
    
    'Puts the sheet names in K.
    For N = 1 To NumberOfSheets
        RawSheet.Range("K" & (N + 2)).Value = wb1.Sheets(N).Name
    Next N
    
    'Copies the sheet names from CET WM and pastes them to CET Dash.
    RawSheet.Range("K3:K" & (NumberOfSheets + 2)).Copy _
        Destination:=UglySheet.Range("B1").End(xlDown).Offset(1, 0)
    
    End Sub

    Thanks for all your help.


    • Edited by NathanaelB Wednesday, December 19, 2012 12:07 PM
    Wednesday, December 19, 2012 11:46 AM
  • The line

    ActiveSheet.Range("B1").Selected

    is not valid, it should be

    ActiveSheet.Range("B1").Select


    Regards, Hans Vogelaar

    Wednesday, December 19, 2012 12:18 PM
  • With that fixed, it's still returning run-time error '1004' on :

    Selection.End(xlDown).Offset(1, 0).Paste


    Wednesday, December 19, 2012 12:45 PM
  • Try

    UglySheet.Paste Destination:=UglySheet.Range("B1")


    Regards, Hans Vogelaar

    • Marked as answer by NathanaelB Thursday, December 20, 2012 5:57 AM
    Wednesday, December 19, 2012 1:13 PM