Stop macro looping if next cell is empty

[Dharma_db]

Need help to stop looping if next cell is empty. This is excel macro I use for copying multiple tabulation data to combine in a single data area. works but looping is not stopping.

Sub CombineToCommonColumns()
'
' CombineToCommonColumns Macro
'
 
'
    iRow = 1
    Do Until IsEmpty(Cells(iRow, 1))
   'Select to column till last
    Range(Selection, Selection.End(xlDown)).Select
    Selection.End(xlDown).Select
    'Select next free cell
    Dim ws As Worksheet
    Set ws = ActiveSheet
    For Each cell In ws.Columns(1).Cells
         If Len(cell) = 0 Then cell.Select: Exit For
    Next cell
    'Go to right and select till last right and last down, select and cut
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.End(xlToRight).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    'Got to home
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.End(xlDown).Select
    'Select next free cell
    For Each cell In ws.Columns(1).Cells
         If Len(cell) = 0 Then cell.Select: Exit For
    Next cell
    ActiveSheet.Paste
    iRow = iRow + 1
    Loop
End Sub

 

[mole999]

are you testing your ability post, or are you asking a legitimate question, in which case we need to move this to a proper forum level

 

[Dharma_db]

Hello, it is a legitimate question. please move it proper forum so that I can get some suggestion/advise in order to fix my issue.

 

[MARK858]

Where do you think you are telling it to end the loop?
Try stepping through the code with F8 so you can see what is happening.

 

[Dharma_db]

Hello, I would like to stop looping after "ActiveSheet.Paste" action if next row is empty.

 

[MARK858]

As I have stated step through your code with F8, if (with your layout) data is being pasted in the next cell is Cells(iRow, 1) ever empty?

Test it with 5 rows of data after adding the red line below so you can see what cell it is referencing.

Do Until IsEmpty(Cells(iRow, 1))
    [COLOR="#FF0000"]MsgBox Cells(iRow, 1)[/COLOR]
        'Select to column till last
        Range(Selection, Selection.End(xlDown)).Select

 

[MARK858]

Sorry forgot to put the .Address at the end...

Do Until IsEmpty(Cells(iRow, 1))
    [COLOR="#FF0000"]MsgBox Cells(iRow, 1).Address[/COLOR]
        'Select to column till last
        Range(Selection, Selection.End(xlDown)).Select

 

[Dharma_db]

I am able to make this fix with below code. my next question is how do I modify to run in multiple sheets in same workbook?

Sub CombineToCommonColumns()'
' CombineToCommonColumns Macro
'
 
'
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    'Set Do loop to stop when an empty cell is reached.
    Do Until IsEmpty(ActiveCell)
    'Select to column till last
    Range(Selection, Selection.End(xlDown)).Select
    Selection.End(xlDown).Select
    'Select next free cell
    Dim ws As Worksheet
    Set ws = ActiveSheet
    For Each cell In ws.Columns(1).Cells
         If Len(cell) = 0 Then cell.Select: Exit For
    Next cell
    'Go to right and select till last right and last down, select and cut
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.End(xlToRight).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    'Got to home
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.End(xlDown).Select
    'Select next free cell
    For Each cell In ws.Columns(1).Cells
         If Len(cell) = 0 Then cell.Select: Exit For
    Next cell
    ActiveSheet.Paste
    ' Step down 1 row from present location.
    'ActiveCell.Offset(1, 0).Select
    Loop
    Application.DisplayAlerts = True
    Application.ScreenUpdating = False
    Dim Results(1 To 2) As String
End Sub

[/QUOTE]

 

[MARK858]

Your code needs a fair bit of tidying up but I haven't time as just going to work (and not much point turning off screenupdating if you are selecting cells) but try the below (untested) which runs on all the sheets (you need data in all the sheets).

Sub CombineToCommonColumns()    '
    ' CombineToCommonColumns Macro
    '

    Dim ws As Worksheet, cell As Range
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    For Each ws In ActiveWorkbook.Worksheets
    'Set Do loop to stop when an empty cell is reached.
    
    ws.Activate
    Do Until IsEmpty(ActiveCell)
        'Select to column till last
        Range(Selection, Selection.End(xlDown)).Select
        Selection.End(xlDown).Select
        'Select next free cell
      
        For Each cell In ws.Columns(1).Cells
            If Len(cell) = 0 Then cell.Select: Exit For
        Next cell
        'Go to right and select till last right and last down, select and cut
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.End(xlToRight).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Cut
        'Got to home
        Range("A1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.End(xlDown).Select
        'Select next free cell
        For Each cell In ws.Columns(1).Cells
            If Len(cell) = 0 Then cell.Select: Exit For
        Next cell
        ActiveSheet.Paste
        ' Step down 1 row from present location.
        'ActiveCell.Offset(1, 0).Select
    Loop
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = False
    Dim Results(1 To 2) As String
End Sub