Do until isblank(ActiveCell) not breaking the loop

[markswjh]

Hi all

I have the following code, and I'm trying to work out why it isn't exiting the loop. I'm a bit of an amateur so please respond as if talking to a small child!

Sub DetentionListAddName()

Sheets("Submition Forms").Select
Range("C4").Select
Do Until IsEmpty(ActiveCell)
    Select Case ActiveCell
        Case "N"
            ActiveCell.Offset(0, -2).Copy
            Sheets("Detentions List").Select
            Range("A1").Select
            Cells(Columns.Count, 1).End(xlUp).Offset(0, 1).Select
            ActiveCell.End(xlDown).Offset(1, 0).Select
            Selection.PasteSpecial
            Sheets("Submition Forms").Select
            ActiveCell.Offset(1, 0).Select
        Case "Y"
            ActiveCell.Offset(1, 0).Select
    End Select
Loop

End Sub

 

[aaewalsh]

Hey

t looks like the problem is that the code is not moving to the next cell in the loop. It is only moving to the next cell if the value is "Y". The problem is with the line "ActiveCell.Offset(1, 0).Select" is not inside the loop. So the code is stuck at the same cell.

Add the line

ActiveCell.Offset(1, 0).Select

after the "End Select" statement, this way the code will move to the next cell regardless of the case.

 

[aaewalsh]

Full Code

Sub DetentionListAddName()
    'Select the sheet named "Submition Forms"
    Sheets("Submition Forms").Select
    'Select cell C4
    Range("C4").Select

    'Start the loop that will run until the active cell is empty
    Do Until IsEmpty(ActiveCell)
        'Check the value of the active cell
        Select Case ActiveCell
            Case "N"
                'Copy the cell two columns to the left
                ActiveCell.Offset(0, -2).Copy
                'Go to the sheet named "Detentions List"
                Sheets("Detentions List").Select
                'Select the first cell in column A
                Range("A1").Select
                'Find the last cell in column A that has data
                Cells(Columns.Count, 1).End(xlUp).Offset(0, 1).Select
                'Select the next empty cell in column A
                ActiveCell.End(xlDown).Offset(1, 0).Select
                'Paste the copied cell in the selected empty cell
                Selection.PasteSpecial
                'Go back to the sheet named "Submition Forms"
                Sheets("Submition Forms").Select
            Case "Y"
                'If the value is "Y", do nothing
        End Select
        'Move to the next cell in column C
        ActiveCell.Offset(1, 0).Select
    Loop
End Sub

 

[markswjh]

Thanks so much

It kept going, I think because of some odd formatting in another Macro. However I fixed the issue by having it cycle through the data in a linked cell as per below. It now works, Your commenting was an amazingly useful way of breaking things down. Really appreciated it!
thanks!

Will

Sub DetentionListAddName() 
    'Formats detentions page to look better and adds new columns for today's date etc.    
    Call FmtDetentions
    'Turn off Screen Updating
    Application.ScreenUpdating = False
    'Select the sheet named "Submition Forms"
    Sheets("Submition Forms").Select
    'Select cell C4
    Range("A4").Select

    'Start the loop that will run until the active cell is empty
    Do Until IsEmpty(ActiveCell)
        'Select Cell to columns to the right
        ActiveCell.Offset(0, 2).Select
        'Check the value of the active cell
        Select Case ActiveCell
            Case "N"
                'Copy the cell two columns to the left
                ActiveCell.Offset(0, -2).Copy
                'Go to the sheet named "Detentions List"
                Sheets("Detentions List").Select
                'Select the first cell in column A
                Range("A1").Select
                'Find the last cell in column A that has data
                Cells(Columns.Count, 1).End(xlUp).Offset(0, 1).Select
                'Select the next empty cell in column A
                ActiveCell.End(xlDown).Offset(1, 0).Select
                'Paste the copied cell in the selected empty cell
                Selection.PasteSpecial
                'Go back to the sheet named "Submition Forms"
                Sheets("Submition Forms").Select
            Case "Y"
                'If the value is "Y", do nothing
        End Select
        'Move to the next cell in column C
        
        ActiveCell.Offset(1, -2).Select
    Loop
'select top cell
Range("A4").Select
'Reactivate screen updating
Application.ScreenUpdating = True

End Sub

 

[aaewalsh]

Thanks so much

It kept going, I think because of some odd formatting in another Macro. However I fixed the issue by having it cycle through the data in a linked cell as per below. It now works, Your commenting was an amazingly useful way of breaking things down. Really appreciated it!
thanks!

Will

Sub DetentionListAddName()
    'Formats detentions page to look better and adds new columns for today's date etc.   
    Call FmtDetentions
    'Turn off Screen Updating
    Application.ScreenUpdating = False
    'Select the sheet named "Submition Forms"
    Sheets("Submition Forms").Select
    'Select cell C4
    Range("A4").Select

    'Start the loop that will run until the active cell is empty
    Do Until IsEmpty(ActiveCell)
        'Select Cell to columns to the right
        ActiveCell.Offset(0, 2).Select
        'Check the value of the active cell
        Select Case ActiveCell
            Case "N"
                'Copy the cell two columns to the left
                ActiveCell.Offset(0, -2).Copy
                'Go to the sheet named "Detentions List"
                Sheets("Detentions List").Select
                'Select the first cell in column A
                Range("A1").Select
                'Find the last cell in column A that has data
                Cells(Columns.Count, 1).End(xlUp).Offset(0, 1).Select
                'Select the next empty cell in column A
                ActiveCell.End(xlDown).Offset(1, 0).Select
                'Paste the copied cell in the selected empty cell
                Selection.PasteSpecial
                'Go back to the sheet named "Submition Forms"
                Sheets("Submition Forms").Select
            Case "Y"
                'If the value is "Y", do nothing
        End Select
        'Move to the next cell in column C
       
        ActiveCell.Offset(1, -2).Select
    Loop
'select top cell
Range("A4").Select
'Reactivate screen updating
Application.ScreenUpdating = True

End Sub

No Problem at all. enjoy Please can you close the message as complete . happy coding