Abort macro when the next blank cell condition is met

Question

I am trying to abort a loop function when a blank cell condition is met but then receive

"Run time error 1004: method 'save as object' workbook failed".

It works fine, but somehow the macro breaks on the

wbMaster.SaveAs ("C:\Users\folder\Desktop\" & ActiveCell.Value & ".xls")

line. I use If (IsEmpty(ActiveCell)) Then Exit Sub thinking it will abort the macro after the condition is met but still no luck.

Let me know what you guys think about my script below. Any advice will be greatly appreciated.

Sub Manipulate()
    Dim wbMaster As Workbook
    Dim wbLocal As Workbook
    
    Set wbLocal = ThisWorkbook
    
    If (IsEmpty(ActiveCell)) Then Exit Sub
    
    Do Until ActiveCell.Value = ""
        Set wbMaster = Workbooks.Open("C:\Users\folder\Desktop\Output.xlsx")
        wbLocal.Worksheets("Input").Activate
         
        wbMaster.Worksheets("Output").Range("B3").Value = ActiveCell.Value
        wbMaster.SaveAs ("C:\Users\folder\Desktop\" & ActiveCell.Value & ".xls")
        wbMaster.Close True
        
        ActiveCell.Offset(1, 0).Select
    Loop
    MsgBox "Export Finished"
End Sub

Say, don't you have to define the active cell first before the loop starts ? — Charlie, May 12 '21 at 05:04
@Charlie the `ActiveCell` property is implicit of `Application.ActiveCell`. If the object qualify is omitted it uses the `ActiveCell` of the `ActiveWindow`. - See documentation [here](https://learn.microsoft.com/en-us/office/vba/api/excel.application.activecell). — Samuel Everson, May 12 '21 at 06:38

score 4 · Answer 1 · edited Jan 07 '22 at 07:09

Few things

Avoid using ActiveCell. You may want to see How to avoid using Select in Excel VBA
Define and work with objects
Find last row in the relevant column. It will be easy to loop. You may want to see How to find last row
Use error handling as you are trying to save a workbook with dynamic string as it may fail.
While saving the file, not only specify the filename with the correct extension but also the relevant file format. You may want to read up on Workbook.SaveAs method (Excel)

Try this. I have commented the code below.

Option Explicit

Sub Manipulate()
    Dim wbMaster As Workbook
    Dim wbLocal As Workbook
    Dim wsLocal As Worksheet
    
    On Error GoTo Whoa
    
    Set wbLocal = ThisWorkbook
    '~~> Change this to the relevant sheet
    Set wsLocal = wbLocal.Sheets("Sheet1")
    
    Dim StartRow As Long
    Dim StartCol As String
    Dim EndRow As Long
    Dim i As Long
    
    '~~> This specifies to start from row 1 of col A which is A1
    '~~> Change as applicable
    StartRow = 1
    StartCol = "A"
    
    With wsLocal
        '~~> Get the last row in that column
        EndRow = .Range(StartCol & .Rows.Count).End(xlUp).Row
        
        '~~> Loop from the start row to end row
        For i = StartRow To EndRow
            '~~> Check if the cell in between is empty or not
            If Len(Trim(.Range(StartCol & i).Value2)) <> 0 Then
                '~~> Open workbook
                Set wbMaster = Workbooks.Open("C:\Users\folder\Desktop\Output.xlsx")
                '~~> Set value
                wbMaster.Worksheets("Output").Range("B3").Value = .Range(StartCol & i).Value2
                
                '~~> Save the file
                wbMaster.SaveAs (Filename:= "C:\Users\folder\Desktop\" & _
                                 .Range(StartCol & i).Value2 & _
                                 ".xls", FileFormat:= 56)
                
                '~~> Give time to excel to save the file.
                DoEvents
                
                '~~> Close without saving. We already saved above
                wbMaster.Close False
            End If
        Next i
    End With
    
    MsgBox "Export Finished"
    
    Exit Sub        
Whoa:
    MsgBox Err.Description
End Sub

score -2 · Accepted Answer · answered May 12 '21 at 05:01

Change where you check for an empty cell in the loop part of the code.

Also, add a variable to refer to the cell instead of using ActiveCell throughout.

Option Explicit

Sub Manipulate()
Dim wbMaster As Workbook
Dim wbLocal As Workbook
Dim rng As Range

    Set wbLocal = ThisWorkbook

    Set rng = ActiveCell

    If rng.Value = "" Then
        Exit Sub
    End If
    
    Do

        Set wbMaster = Workbooks.Open("C:\Users\folder\Desktop\Output.xlsx")

        wbLocal.Worksheets("Input").Activate

        wbMaster.Worksheets("Output").Range("B3").Value = rng.Value

        wbMaster.SaveAs ("C:\Users\folder\Desktop\" & rng.Value & ".xls")

        wbMaster.Close True

        Set rng = rng.Offset(1, 0)

    Loop Until rng.Value = ""

    MsgBox "Export Finished"

End Sub

Abort macro when the next blank cell condition is met

2 Answers2