clear contents of entire sheet except the contents of the table

how could this be achieved please

Select the range of the worksheet that isn't the table and use the .clearcontents command.

Try this: Run the macro recorder, select the range you want cleared and press DELETE. Then stop the macro recorder and look at the code it's written for you.

Hi wayneg,

There is no magic elixir function for your question. Try code like the following which worked for me:

Sub KeepTable()

  Const sTableRange = "E5:G9"
  
  Dim myRange As Range
  Dim r As Range
  
  'Create the range for the Table to be saved
  Set myRange = Range(sTableRange)
  
  'Process each cell in the Range of the Sheet that is Used
  For Each r In ActiveSheet.UsedRange
  
    'Clear the contents of the cell if the cell is NOT contained in the Table Range
    If Intersect(r, myRange) Is Nothing Then
      r.ClearContents
    End If
  Next r
  
  'Clear Object Pointer
  Set myRange = Nothing

End Sub

Lewis

Long, but does the trick. Just change the reference in red to reference the table you want to keep.

Sub ClearOutsideTable()

Dim rngKeep As Range, rngThrow As Range
Dim rng As Range, rngLastCell As Range
    

    Set rngKeep = Range("B5:D10")

    Set rngLastCell = Cells.SpecialCells(xlCellTypeLastCell)
    
    If rngLastCell.Row < rngKeep.Item(rngKeep.Count).Row Then Set rngLastCell = Cells(rngKeep.Item(rngKeep.Count).Row, rngLastCell.Column)
    If rngLastCell.Column < rngKeep.Item(rngKeep.Count).Column Then Set rngLastCell = Cells(rngLastCell.Row, rngKeep.Item(rngKeep.Count).Column)
    
    If Not rngKeep.Row = 1 Then Set rngThrow = Range("1:" & CStr(rngKeep.Row - 1)).EntireRow
            
    If Not rngLastCell.Row = rngKeep.Item(rngKeep.Count).Row Then
        If rngThrow Is Nothing Then
            Set rngThrow = Range(Cells(rngKeep.Item(rngKeep.Count).Row + 1, 1), Cells(rngLastCell.Row, 1)).EntireRow
        Else
            Set rngThrow = Union(rngThrow, Range(Cells(rngKeep.Item(rngKeep.Count).Row + 1, 1), Cells(rngLastCell.Row, 1)).EntireRow)
        End If
    End If
    
    If Not rngKeep.Column = 1 Then
        If rngThrow Is Nothing Then
            Set rngThrow = Range(Cells(1, 1), Cells(1, rngKeep.Column)).EntireColumn
        Else
            Set rngThrow = Union(rngThrow, Range(Cells(1, 1), Cells(1, rngKeep.Column - 1)).EntireColumn)
        End If
    End If
    
    If Not rngLastCell.Column = rngKeep.Item(rngKeep.Count).Column Then
        If rngThrow Is Nothing Then
            Set rngThrow = Range(Cells(1, rngKeep.Item(rngKeep.Count).Column + 1), Cells(1, rngLastCell.Column)).EntireColumn
        Else
            Set rngThrow = Union(rngThrow, Range(Cells(1, rngKeep.Item(rngKeep.Count).Column + 1), Cells(1, rngLastCell.Column)).EntireColumn)
        End If
    End If
    
    rngThrow.ClearContents
    
End Sub

Blimey, I'm much lazier than you two. I'd just select the 4 blocks around the table and clear them, all done in 4 lines of code. eg.

columns("A:C").clearcontents
columns("F:ZZ").clearcontents
rows("1:5").clearcontents
rows("10:1048000").clearcontents