How do I add a "do you wish to continue" warning message and bring blanks to bottom of table when creating a clear button for certain cell values?

[cheesypoofs]

I am making a funnel management tool and I am trying to use .AutoFilter to clear contents in a row on Table 1 if it states "installed", "scheduled", or "cancelled in the "stage" column. I do not want to delete the rows entirely because I want to keep the number of rows in the table as 100. I also want to add a warning message when the button is clicked to confirm that the user wants to run this macro since running the macro a second time with if there are no rows to clear ends up making a mess of the table and would confuse users.

This is the code I am currently trying to build on

Sub ClearSold()

Dim dRng As Range
With ActiveSheet.ListObjects("Table1")
    .Range.AutoFilter Field:=7, Criteria1:=Array("Cancelled", "Installed", "Scheduled"), Operator:=xlFilterValues
    If WorksheetFunction.Subtotal(2, .DataBodyRange) > 0 Then
        Set dRng = .DataBodyRange.SpecialCells(xlCellTypeVisible)
        .Range.AutoFilter
        dRng.ClearContents
    End If
    
End With

End Sub

 

[rlv01]

since running the macro a second time with if there are no rows to clear ends up making a mess of the table and would confuse users

The way to avoid that is to avoid the the clear operation unless there is something to clear (not tested):

Sub ClearSold()

    Dim dRng As Range
    With ActiveSheet.ListObjects("Table1")
        .Range.AutoFilter Field:=7, Criteria1:=Array("Cancelled", "Installed", "Scheduled"), Operator:=xlFilterValues
        If WorksheetFunction.Subtotal(2, .DataBodyRange) > 0 Then
            On Error Resume Next
            Set dRng = .DataBodyRange.SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not dRng Is Nothing Then
                .Range.AutoFilter
                dRng.ClearContents
            End If
        End If
    End With

End Sub

 

[cheesypoofs]

This still gives the same issues once clicked twice and it does not move blanks to the below the other rows that are still there sadly... Do you know how I would remedy this?

 

[cheesypoofs]

The way to avoid that is to avoid the the clear operation unless there is something to clear (not tested):

Sub ClearSold()

    Dim dRng As Range
    With ActiveSheet.ListObjects("Table1")
        .Range.AutoFilter Field:=7, Criteria1:=Array("Cancelled", "Installed", "Scheduled"), Operator:=xlFilterValues
        If WorksheetFunction.Subtotal(2, .DataBodyRange) > 0 Then
            On Error Resume Next
            Set dRng = .DataBodyRange.SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not dRng Is Nothing Then
                .Range.AutoFilter
                dRng.ClearContents
            End If
        End If
    End With

End Sub

This still gives the same issues once clicked twice and it does not move blanks to the below the other rows that are still there sadly... Do you know how I would remedy this?

 

[rlv01]

Perhaps this.

Sub ClearSold()
    Dim LO As ListObject
    Dim dRng As Range
    Dim CA As Variant, TA As Variant, N As Variant
    Dim I As Long, J As Long, RRow As Long, RCol As Long
    
    Set LO = ActiveSheet.ListObjects("Table1")
    
    With LO
        .Range.AutoFilter Field:=7, Criteria1:=Array("Cancelled", "Installed", "Scheduled"), Operator:=xlFilterValues
        If WorksheetFunction.Subtotal(2, .DataBodyRange) > 0 Then
            On Error Resume Next
            Set dRng = .DataBodyRange.SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            .Range.AutoFilter
            If Not dRng Is Nothing Then
                dRng.ClearContents
            End If
        End If
        .Range.AutoFilter
    End With
    
    CA = LO.DataBodyRange.Value
    TA = CA
    I = 0
    For RRow = LBound(CA, 1) To UBound(CA, 1)
        J = 0
        N = Trim(CA(RRow, LBound(CA, 2)))
        If N <> "" Then
            I = I + 1
        End If
        For RCol = LBound(CA, 2) To UBound(CA, 2)
            TA(RRow, RCol) = vbNullString
            N = Trim(CA(RRow, RCol))
            If N <> "" Then
                J = J + 1
                TA(I, J) = CA(RRow, RCol)
            End If
        Next RCol
    Next RRow
    LO.DataBodyRange.Value = TA
End Sub

 

[cheesypoofs]

Perhaps this.

Sub ClearSold()
    Dim LO As ListObject
    Dim dRng As Range
    Dim CA As Variant, TA As Variant, N As Variant
    Dim I As Long, J As Long, RRow As Long, RCol As Long
   
    Set LO = ActiveSheet.ListObjects("Table1")
   
    With LO
        .Range.AutoFilter Field:=7, Criteria1:=Array("Cancelled", "Installed", "Scheduled"), Operator:=xlFilterValues
        If WorksheetFunction.Subtotal(2, .DataBodyRange) > 0 Then
            On Error Resume Next
            Set dRng = .DataBodyRange.SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            .Range.AutoFilter
            If Not dRng Is Nothing Then
                dRng.ClearContents
            End If
        End If
        .Range.AutoFilter
    End With
   
    CA = LO.DataBodyRange.Value
    TA = CA
    I = 0
    For RRow = LBound(CA, 1) To UBound(CA, 1)
        J = 0
        N = Trim(CA(RRow, LBound(CA, 2)))
        If N <> "" Then
            I = I + 1
        End If
        For RCol = LBound(CA, 2) To UBound(CA, 2)
            TA(RRow, RCol) = vbNullString
            N = Trim(CA(RRow, RCol))
            If N <> "" Then
                J = J + 1
                TA(I, J) = CA(RRow, RCol)
            End If
        Next RCol
    Next RRow
    LO.DataBodyRange.Value = TA
End Sub

This worked! Thank you!