Macro not reaching bottom of the worksheet (due to blank rows)

[gomes123]

I have an excel macro to do the following

For Column O, for each cell in Column O, if cell is blank, then for that row, clear all cells going right.

For example, if Cell O7 is blank, it will clear all the contents of all the Cells from P7,Q7,R7, S7 etc. onwards. But leaving the cells on the left (A7 to N7) untouched.

The macro below works, but after encountering a blank cell (O7), then there is values in O8 onwards, but the macro doesnt seem to go through to the bottom of the sheet? How would I fix this? Most appreciated, thanks.

Sub ClearCellsIfBlank()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long, j As Long

    Set ws = ThisWorkbook.Sheets("Sheet1") 
    lastRow = ws.Cells(ws.Rows.Count, "O").End(xlUp).Row

    For i = 1 To lastRow
        If IsEmpty(ws.Cells(i, "O")) Then
            For j = i To ws.Cells(i, ws.Columns.Count).End(xlToLeft).Column
                ws.Cells(i, j).ClearContents
            Next j
        End If
    Next i

End Sub

 

[Cubist]

The code isn't doing what you're describing. It's deleting more than column P onwards because you're indexing i and j incorrectly.
Try this instead on a copy.

Sub ClearCellsIfBlank()
    Dim ws As Worksheet
    Dim dataRange As Range
    Dim columnORange As Range
    Dim dataArray As Variant
    Dim i As Long, j As Long

    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set dataRange = ws.Range("O1").CurrentRegion
    Set columnORange = dataRange.Columns("O")
    columnOnum = columnORange.Column
    dataArray = dataRange.Value

    For i = 1 To UBound(dataArray, 1)
        If IsEmpty(columnORange.Cells(i)) Then
            For j = columnOnum To UBound(dataArray, 2)
                dataArray(i, j) = ""
            Next j
        End If
    Next i

    dataRange.Value = dataArray
End Sub

 

[kevin9999]

Another option:

Option Explicit
Sub ClearToRight()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")
    Dim LRow As Long, LCol As Long, c As Range
    LRow = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
    
    For Each c In Range("O1:O" & LRow)
        If IsEmpty(c) Then ws.Range(ws.Cells(c.Row, "P"), ws.Cells(c.Row, LCol)).ClearContents
    Next c
End Sub

 

[Peter_SSs]

.. yet another one (without looping)

Sub ClearRight()
  On Error Resume Next
  Intersect(Columns("O").SpecialCells(xlBlanks).EntireRow, Columns("O:XFD")).ClearContents
End Sub

 

[gomes123]

Thanks all 3 of you, if I could choose all 3 as the solutions I would! Most appreciated!

.. yet another one (without looping)

Sub ClearRight()
  On Error Resume Next
  Intersect(Columns("O").SpecialCells(xlBlanks).EntireRow, Columns("O:XFD")).ClearContents
End Sub

Thanks, simple and short! Works very well!

Another option:

Option Explicit
Sub ClearToRight()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")
    Dim LRow As Long, LCol As Long, c As Range
    LRow = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
   
    For Each c In Range("O1:O" & LRow)
        If IsEmpty(c) Then ws.Range(ws.Cells(c.Row, "P"), ws.Cells(c.Row, LCol)).ClearContents
    Next c
End Sub

Thanks, works perfectly too!

The code isn't doing what you're describing. It's deleting more than column P onwards because you're indexing i and j incorrectly.
Try this instead on a copy.

Sub ClearCellsIfBlank()
    Dim ws As Worksheet
    Dim dataRange As Range
    Dim columnORange As Range
    Dim dataArray As Variant
    Dim i As Long, j As Long

    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set dataRange = ws.Range("O1").CurrentRegion
    Set columnORange = dataRange.Columns("O")
    columnOnum = columnORange.Column
    dataArray = dataRange.Value

    For i = 1 To UBound(dataArray, 1)
        If IsEmpty(columnORange.Cells(i)) Then
            For j = columnOnum To UBound(dataArray, 2)
                dataArray(i, j) = ""
            Next j
        End If
    Next i

    dataRange.Value = dataArray
End Sub

Thanks for the code and the explanation as to why the original code was not working, most appreciated!

 

[Peter_SSs]

You're welcome. Glad we could help. Thanks for the follow-up.