循环浏览工作表以删除某些单元格

Question

I wish to delete specific cells from the sheets in a workbook. While doing so it should also delete specific cells having formula error in these worksheets of the workbook. I used a recent program in stackoverflow by @Blind Seer as per following link which is for similar applications.

incorporating-sheet-loop

Sample of workbook sheets before program run are appended below

Code adopted by me as follows.

Sub DeleteCells()

Dim rng As Range, rngError As Range, delRange As Range
Dim i As Long, j As Long, k As Long
Dim wks As Worksheet

On Error Resume Next

Set rng = Application.InputBox("Select cells To be deleted", Type:=8)

On Error GoTo 0

If rng Is Nothing Then Exit Sub Else rng.Delete

For k = 1 To ThisWorkbook.Worksheets.Count 'runs through all worksheets

  Set wks = ThisWorkbook.Worksheets(k)

  With wks

    For i = 1 To 7 '<~~ Loop trough columns A to G

        '~~> Check if that column has any errors
        On Error Resume Next

        Set rngError = .Columns(i).SpecialCells(xlCellTypeFormulas, xlErrors)

        On Error GoTo 0

        If Not rngError Is Nothing Then
            For j = 1 To 100 '<~~ Loop Through rows 1 to 100
                If .Cells(j, i).Text = "#DIV/0!" Then
                    '~~> Store The range to be deleted
                    If delRange Is Nothing Then
                        Set delRange = .Columns(i)
                        Exit For
                    Else
                        Set delRange = Union(delRange, .Columns(i))
                    End If
                End If
             Next j
         End If

     Next i

  End With

Next k

'~~> Delete the range in one go
If Not delRange Is Nothing Then delRange.Delete

End Sub

After running the code it deletes the cell input in the input box ie it blanks out the data in the cell and append rest of the data in the row at the end of the last filled row. It is not blanking out error cells and the program gives the error message: Method 'Union of object_Global failed

on the following code line

'Set delRange = Union(delRange, .Columns(i))'

Sample data after proram run is appended below.

Please help in locating the error in the program. Result desired is Input cell range should blank out retaining its row position. Same also for error cells.

Thanks

Answer 1

Option Explicit

Sub DeleteCells()
    Dim ws As Worksheet, rng As Range, rngErr As Range

    On Error Resume Next

    Set rng = Application.InputBox("Select cells to be deleted", Type:=8)

    If Not rng Is Nothing Then
        rng.Delete
        For Each ws In ThisWorkbook.Worksheets
            Set rngErr = ws.UsedRange.SpecialCells(xlCellTypeFormulas, xlErrors)
            If Not rngErr Is Nothing Then rngErr.Clear
        Next
    End If
End Sub

Answer 2

Not much of a solution but the reason for the error is that Union does not work across worksheets. It will work for ranges on a single sheet.

You could adapt your code to work one sheet at a time:

Sub DeleteCells()

Dim rng As Range, rngError As Range, delRange As Range
Dim i As Long, j As Long, k As Long
Dim wks As Worksheet

On Error Resume Next

Set rng = Application.InputBox("Select cells To be deleted", Type:=8)

On Error GoTo 0

If rng Is Nothing Then Exit Sub Else rng.Delete

For k = 1 To ThisWorkbook.Worksheets.Count 'runs through all worksheets

  'Set wks = ThisWorkbook.Worksheets(k)
  'With wks
  With  ThisWorkbook.Worksheets(k)  '<<do each sheet individually so that Union functions as expected  

    For i = 1 To 7 '<~~ Loop trough columns A to G

        '~~> Check if that column has any errors
        On Error Resume Next

        Set rngError = .Columns(i).SpecialCells(xlCellTypeFormulas, xlErrors)

        On Error GoTo 0

        If Not rngError Is Nothing Then
            For j = 1 To 100 '<~~ Loop Through rows 1 to 100
                If .Cells(j, i).Text = "#DIV/0!" Then
                    '~~> Store The range to be deleted
                    If delRange Is Nothing Then
                        Set delRange = .Columns(i)
                        Exit For
                    Else
                        Set delRange = Union(delRange, .Columns(i))
                    End If
                End If
             Next j
         End If

     Next i

  End With

Next k

'~~> Delete the range in one go
If Not delRange Is Nothing Then delRange.Delete

End Sub

Answer 3

You can use IsNumeric to check if the cells contain numeric values. Errors are not numeric values, so IsNumeric(Cell with error) = False. I modified your code:

Set wks = ThisWorkbook.Worksheets(k)

  With wks

    For i = 1 To 7 '<~~ Loop trough columns A to G

        '~~> Check if that column has any errors
        On Error Resume Next

        Set rngError = .Columns(i).SpecialCells(xlCellTypeFormulas, xlErrors)

        On Error GoTo 0

        If Not rngError Is Nothing Then
            For j = 1 To 100 '<~~ Loop Through rows 1 to 100
                If Not IsNumeric(.Cells(j, i)) Then
                    '~~> Store The range to be deleted
                    If delRange Is Nothing Then
                        Set delRange = .Columns(i)
                        Exit For
                    Else
                        Set delRange = Union(delRange, .Columns(i))
                    End If
                End If
             Next j
         End If

     Next i

  End With

Next k

'~~> Delete the range in one go
If Not delRange Is Nothing Then delRange.Delete

End Sub

Note: This means that if sometimes text is to be entered, it will count it as an ERROR. So be careful if that's the case!

Also, as per my comment; If your cells are quotients of cells on other cells, consider using this instead of code; support.microsoft.com/en-us/kb/182188. To simply skip the divisions.