Sub DeleteTextFromColoredCells()
Application.ScreenUpdating = False
Dim myTable As Table, myCell As Cell
Dim CurrentTexture As Long
Dim CurrentForegroundPatternColor As Long
Dim CurrentBackgroundPatternColor As Long
If Not Selection.Information(wdWithInTable) Then
  MsgBox "Place the cursor in a table cell with a colored pattern."
  Exit Sub
End If
With Selection.Range.Cells(1).Shading
  CurrentTexture = .Texture
  CurrentForegroundPatternColor = .ForegroundPatternColor
  CurrentBackgroundPatternColor = .BackgroundPatternColor
End With
For Each myTable In ActiveDocument.Tables
  For Each myCell In myTable.Range.Cells
    With myCell
      If .Shading.Texture = CurrentTexture Then
        If .Shading.ForegroundPatternColor = CurrentForegroundPatternColor Then
          If .Shading.BackgroundPatternColor = CurrentBackgroundPatternColor Then
            .Range.Text = ""
          End If
        End If
      End If
    End With
  Next myCell
Next myTable
Application.ScreenUpdating = True
End Sub