如果特定范围内所有基于公式的单元格为0或空白，则删除行

Question

I am trying to write a code which basically looks at rows 13-33 and deletes the entire row if the cells in Columns BM are all Blank AND column A is NOT blank. The issue that I am having is that all my cells are referencing the value from another sheet (formula-based). When I run my code below, it does not seem to recognize these formula-based cells as "0"s even though that is there value.

It only deletes the rows which have 0's but not referencing another cell. I do not want to have to go copy and paste everything as values before running this since I want to be able to keep the formulas.

Please take a look below and advise on how I can do this.

Sub ScheduleB()
    On Error GoTo errHandler

    Const TOP_ROW As Long = 13
    Const BOTTOM_ROW As Long = 33

    Dim rowIndex As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With ThisWorkbook.Worksheets("Schedule A Template")
        For rowIndex = .Cells(BOTTOM_ROW, "A").End(xlUp).Row To TOP_ROW Step -1
            If Not IsEmpty(.Cells(rowIndex, "A").Value2) Then '...column A is not blank.
                If Application.WorksheetFunction.CountA(.Range(.Cells(rowIndex, "B"), .Cells(rowIndex, "M"))) = 0 Then '...all cells on row rowIndex from columns B to M are blank.
                    .Rows(rowIndex).Delete Shift:=xlUp
                End If
            End If
        Next
    End With

Cleanup:
    On Error Resume Next
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Exit Sub

errHandler:
    MsgBox Err.Description, vbExclamation + vbOKOnly, "Error"
    Resume Cleanup
End Sub

Answer 1

Building on my answer to your preceding question , you can scan each row's B to M cells and decide whether you want to delete the row.

Sub ScheduleB()
    On Error GoTo errHandler

    Const TOP_ROW As Long = 13
    Const BOTTOM_ROW As Long = 33

    Dim rowIndex As Long
    Dim cell As Excel.Range
    Dim bDelete As Boolean

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With ThisWorkbook.Worksheets("Schedule A Template")
        For rowIndex = .Cells(BOTTOM_ROW, "A").End(xlUp).Row To TOP_ROW Step -1
            If Not IsEmpty(.Cells(rowIndex, "A").Value2) Then '...column A is not blank.
                bDelete = True

                For Each cell In .Range(.Cells(rowIndex, "B"), .Cells(rowIndex, "M")).Cells
                    If Not IsEmpty(cell.Value2) Then
                        If VarType(cell.Value2) = vbDouble Then
                            If cell.Value2 <> 0 Then
                                bDelete = False 'Not deleting because a numeric value is non-zero.
                            End If
                        Else
                            bDelete = False 'Not deleting because we've hit a non-blank, non-numeric value, such as a string or an error.
                        End If
                    End If

                    If Not bDelete Then
                        Exit For
                    End If
                Next

                If bDelete Then
                    '.Rows(rowIndex).Delete Shift:=xlUp
                Else
                    Debug.Print "will not delete row " & CStr(rowIndex)
                End If
            End If
        Next
    End With

Cleanup:
    On Error Resume Next
    Set cell = Nothing
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Exit Sub

errHandler:
    MsgBox Err.Description, vbExclamation + vbOKOnly, "Error"
    Resume Cleanup
End Sub

Your preceding question did not mention the presence of formulas.