VBA code jumping back to start of sub

K1600

Board Regular
Joined
Oct 20, 2017
Messages
181
I have the below code which simply copies a selection of text and then pastes it into a sheet in another workbook.

For ease, lets call the two workbooks a user and master. The code is all in the 'user' workbook, when I step through the 'Enter and Store' macro I get to the row where the 'master' workbook opens without issue but then with the next press of F8 it jumps back to the Sub Enter_and_store() line and then subsequent F8's run through all of the code again rather than selecting the 'DATA' sheet. If I manually move the process to the point where it selects the 'DATA' sheet, the rest of the process works perfectly. The last part of the code using the FORM sheet is back in the 'user' workbook again.

Can anyone help please?

VBA Code:
Sub Enter_and_store()
'
    Range("C2:C6").Select
    Selection.Copy
Set wbk = Workbooks.Open("Master workbook filepath")
    Sheets("DATA").Select
    Range("A1048576").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    
    Sheets("FORM").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("C2").Select
End Sub
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Try this:

VBA Code:
Sub Enter_and_store()
'
    Dim WB As Workbook: Set WB = ActiveWorkbook
    Dim wbk As Workbook

    WB.Range("C2:C6").Copy
Set wbk = Workbooks.Open("Master workbook filepath")
    wbk.Sheets("DATA").Range("A1048576").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    wbk.Save
    wbk.Close
   

    WB.Sheets("FORM").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("C2").Select
End Sub
 
Upvote 0
Try this:

VBA Code:
Sub Enter_and_store()
'
    Dim WB As Workbook: Set WB = ActiveWorkbook
    Dim wbk As Workbook

    WB.Range("C2:C6").Copy
Set wbk = Workbooks.Open("Master workbook filepath")
    wbk.Sheets("DATA").Range("A1048576").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    wbk.Save
    wbk.Close
  

    WB.Sheets("FORM").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("C2").Select
End Sub

Thanks for the speedy reply, I have tried this but it still returns to the start after Set wbk = Workbooks.Open.....?
 
Upvote 0
Thanks for the speedy reply, I have tried this but it still returns to the start after Set wbk = Workbooks.Open.....?

I've just had another look at it and it seems to be the Set wbk = Workbooks.Open line that is causing the issue. Wherever I put that line within the code, it is after it runs that it returns to the start.
 
Upvote 0
How about this?

VBA Code:
Sub Enter_and_store()
'
    Dim WB As Workbook: Set WB = ActiveWorkbook
    Dim wbk As Workbook
    Dim fd As Office.FileDialog
    Dim strFile As String

    WB.Range("C2:C6").Copy

    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xlsx?", 1
        .Title = "Select a File"
        .AllowMultiSelect = False
        .InitialFileName = "C:\Users\" & Environ("UserName") & "\Desktop"
        If .Show = True Then
            strFile = .SelectedItems(1)
            Workbooks.Open Filename:=strFile
        End If
    End With

    Set wbk = ActiveWorkbook
    wbk.Sheets("DATA").Range("A1048576").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    wbk.Save
    wbk.Close
   

    WB.Sheets("FORM").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("C2").Select
End Sub
 
Upvote 0
How about this?

VBA Code:
Sub Enter_and_store()
'
    Dim WB As Workbook: Set WB = ActiveWorkbook
    Dim wbk As Workbook
    Dim fd As Office.FileDialog
    Dim strFile As String

    WB.Range("C2:C6").Copy

    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xlsx?", 1
        .Title = "Select a File"
        .AllowMultiSelect = False
        .InitialFileName = "C:\Users\" & Environ("UserName") & "\Desktop"
        If .Show = True Then
            strFile = .SelectedItems(1)
            Workbooks.Open Filename:=strFile
        End If
    End With

    Set wbk = ActiveWorkbook
    wbk.Sheets("DATA").Range("A1048576").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    wbk.Save
    wbk.Close
  

    WB.Sheets("FORM").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("C2").Select
End Sub
That give me a Run-Time Error 438 at the WB.Range("C2:C6").Copy line.
 
Upvote 0
It looks like (one of) the code modules has become corrupted. Would recommend exporting your code modules and saving your workbook as .xlsx. Now close Excel completely, then open the just saved .xlsx workbook, import the code modules and save the workbook again as .xlsm. See if this fixes your problem.
 
Upvote 0
It looks like (one of) the code modules has become corrupted. Would recommend exporting your code modules and saving your workbook as .xlsx. Now close Excel completely, then open the just saved .xlsx workbook, import the code modules and save the workbook again as .xlsm. See if this fixes your problem.

Fab thanks. I will give that a whirl in the morning. Thanks for your help.
 
Upvote 0
It looks like (one of) the code modules has become corrupted. Would recommend exporting your code modules and saving your workbook as .xlsx. Now close Excel completely, then open the just saved .xlsx workbook, import the code modules and save the workbook again as .xlsm. See if this fixes your problem.
I've tried this but still get the same issue with both my code and that suggested by sax2play above.
 
Upvote 0
I've never seen something like this before, apart from expected or intended recursion, of course.
I'm willing to examine your issue, provided you don't change anything in the current code in your workbook.
If you agree upload your workbook to a file share site like WeTransfer or DropBox and post a link within this thread.
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,238
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top