CODEWITHSUNDEEP
excelvba
user2151190
user2151190

Reputation: 189

call Sub not working properly

Why this call of sub is not working properly? I get an error that there are undefined objects. I believe this can be a little problem but cannot find a solution. I am trying to make new sheetnames but the code is too long for VBA , so I have to split the code, and continue in a second Sub. (apparently it is limited to 15 of 16 handlings)

Thanks in advance.

below my startcode

   Sub Macro1()
   ' Macro1 Macro
   Dim wbNew As Workbook
   'sheet 1----------------------------------------------------------------
   Application.ScreenUpdating = False
   ThisWorkbook.Sheets(1).Activate
   Range("A1:S53").Select
   Range("S53").Activate
   Selection.Copy

   Set wbNew = Workbooks.Add

    wbNew.Sheets(1).Activate
   Range("A1:S53").Select

    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False

    wbNew.Sheets(1).Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Range("A1").Select
    ActiveSheet.Paste


    Range("A15").Select


    Call vanaf_17

    ActiveWorkbook.SaveAs Filename:= _
    "C:\Path\" & "per 1-15" & " " & Format(Range("C13"), "mmmm") & " " & Format(Range("C13"), "YYYY") & ".xlsx"
     FileFormat = xlOpenXMLWorkbook
    ActiveWindow.Close

  End Sub

code to call

 Sub vanaf_17()
 Dim wbNew As Workbook
 Application.ScreenUpdating = False
 'sheet 17----------------------------------------------------------------
'here starts a new sheet!!!!!!!!!!!!!
 Sheets.Add After:=ActiveSheet

ThisWorkbook.Sheets(1).Activate
Range("A1:S53").Select
Range("S53").Activate
Selection.Copy

'change here sheet nr!!!!!!!
wbNew.Sheets(17).Activate
Range("A1:S53").Select

Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False

'change here sheet nr!!!!!!!
wbNew.Sheets(17).Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
Range("A1").Select
ActiveSheet.Paste


'Here ends a new sheet!!!!!

 End Sub

Upvotes: 0

Views: 2883

Answers (1)

JNevill
JNevill

Reputation: 50034

You'll need to set wbnew in that second sub as well. The second sub has no idea what you mean when you say wbnew. When you have a variable in a subroutine or function it exists only in the subroutine or function. As soon as you move to another subroutine, your variables are 100% worthless.

To get around this, you can pass parameters between subs.

When you start your second sub Sub vanaf_17() Do it like so:

Sub vanaf_17(wbNew as Workbook)
    ....your code
End Sub

When you call vanaf_17() do it like so:

Call vanaf_17 webNew

Also, since you are declaring webNew as a workbook in the parameters, delete the dim wbNew as Workbook bit in vanaf_17 otherwise you'll get an error.

Lastly, There is no reason why you need to split these up into two subroutines. I've never heard of '15 or 16 handling' limit and I'm not real sure what that means. I've seen some ugly ass recorded macro code that goes on for thousands of lines of .select and .activate and oh-my-god-no-that-is-such-a-bad-idea for what feels like forever. Excel can handle it.

Updated: Here is what the code would look like with this change:

Sub Macro1()
    ' Macro1 Macro
    Dim wbNew As Workbook
    'sheet 1----------------------------------------------------------------
    Application.ScreenUpdating = False
    ThisWorkbook.Sheets(1).Activate
    Range("A1:S53").Select
    Range("S53").Activate
    Selection.Copy

    Set wbNew = Workbooks.Add

    wbNew.Sheets(1).Activate
    Range("A1:S53").Select

    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False

    wbNew.Sheets(1).Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Range("A1").Select
    ActiveSheet.Paste


    Range("A15").Select


    Call vanaf_17 wbNew

    ActiveWorkbook.SaveAs Filename:= _
    "C:\Path\" & "per 1-15" & " " & Format(Range("C13"), "mmmm") & " " & Format(Range("C13"), "YYYY") & ".xlsx"
     FileFormat = xlOpenXMLWorkbook
    ActiveWindow.Close

End Sub

Sub vanaf_17(wbNew AS Workbook) 

    Application.ScreenUpdating = False

    'sheet 17----------------------------------------------------------------
    'here starts a new sheet!!!!!!!!!!!!!
    Sheets.Add After:=ActiveSheet

    ThisWorkbook.Sheets(1).Activate
    Range("A1:S53").Select
    Range("S53").Activate
    Selection.Copy

    'change here sheet nr!!!!!!!
    wbNew.Sheets(17).Activate
    Range("A1:S53").Select

    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False

    'change here sheet nr!!!!!!!
    wbNew.Sheets(17).Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Range("A1").Select
    ActiveSheet.Paste


    'Here ends a new sheet!!!!!

 End Sub

That being said, there are some changes here that I think will help. Namely, you could loop through all the sheets that you care about in thisWorkbook, and call your subroutine to copy and paste the A1:S53 range into a new worksheet in the new workbook. Below I have a quick example of what that would look like. I kept some of the unnecessary .select and .activate stuff in there, because I figured this change was dramatic enough. You'll see that all of your sheet creation and copying/pasting is now done in the second subroutine. The first subroutine just sets up the new workbook, loops through the sheets, and then saves the new workbook. 

Sub Macro1()
    ' Create a new workbook. Then loop through each worksheet in this workbook (that we care about)
    '   and call the CreateNewWS subroutine to copy the A1:S53 range for each worksheet into the
    '   new workbook

    Application.ScreenUpdating = False

    'Create a new workbook, assign it to wbNew variable
    Dim wbNew As Workbook
    Set wbNew = Workbooks.Add

    'Loop through all the sheets in the current workbook that we care about
    Dim sheetname as string
    For each sheetname in Array("sheet1", "sheet2", "sheet3", "sheet4")

        'call the CreateNewWS subroutine to do the sheet creation and copying and pasting
        call CreateNewWS wbNew, thisWorkbook.Sheets(sheetname)

    Next sheetname

    'You could also loop through all of the worksheets in thisworkbook if you want to copy every worksheet:
    'Dim ws as worksheet
    'For each ws in ThisWorkbook.Worksheets
    '   call CreateNewWS wbNew, ws
    'Next ws

    'Save the new workbook
    newWb.SaveAs Filename:= _
    "C:\Path\" & "per 1-15" & " " & Format(Range("C13"), "mmmm") & " " & Format(Range("C13"), "YYYY") & ".xlsx"
     FileFormat = xlOpenXMLWorkbook

    'Close the new workbook
    newWb.Close

    'Don't forget to turn this back on. Yikes.
    Application.ScreenUpdating = True
End Sub

Sub CreateNewWS(wbNew AS Workbook, ws as Worksheet) 

    'This subroutine takes in the wbNew and the worksheet (ws) that we are copying from.
    '   it copys range A1:S53 from the ws to the wbNew's new worksheet.


    'This will hold the new worksheet we are adding to the wbNew
    Dim wsNew as worksheet

    'Add a new worksheet to the new workbook
    wbNew.Activate
    set wsNew = wbNew.Sheets.Add After:=ActiveSheet

    'Activate and copy from current workbook
    ws.Activate
    ws.Range("A1:S53").Select
    Selection.Copy

    'Activate and paste into newWb      
    wsNew.Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False


 End Sub

I haven't really tested this change, but the guts of it are accurate. If you do decide to switch over to this type of logic and you run into errors, it would be prudent to create a new stackoverflow question to work through the problem.

Upvotes: 1

Related Questions