Deleting formatted text in MS Excel through VBA

Sorry ... don't see the example.

Try this .. if it's a color other than red, you'll need to adjust the color value in line 4.

Sub DeleteByColor()
    With Application.FindFormat.Font
        .Subscript = False
        .Color = 255
        .TintAndShade = 0
    End With
    
    Dim rng As Range
    Dim sht As Worksheet
    
    For Each sht In ActiveWorkbook.Sheets
        Set rng = Range("A1")
        Debug.Print "Processing sheet " & sht.Name
        While Not (rng Is Nothing)
            Set rng = sht.Cells.Find(What:="", After:=rng, LookIn:=xlFormulas, LookAt:= _
               xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
               , SearchFormat:=True)
        
            If Not (rng Is Nothing) Then
                Debug.Print "Deleting data in " & rng.Address
                rng.ClearContents
                rng.ClearFormats
            End If
        Wend
    Next
End Sub

Select allOpen in new window

To verify the color of the contents of a cell, open the Visual Basic Immediate Window and enter:

Debug.Print Range("A1").Font.Color

Select allOpen in new window

... Replace "A1" with the cell you are interested in.

Try this. It finds any red cells in each sheet and creates a range o delete. If the search is successful then it clears the range.

This will be much faster than finding and deleting individual cells

Option Explicit


Sub DeleteColouredCells()
    Dim oWs As Worksheet
    Dim rCl As Range, rToDelete As Range
    Dim lColour As Long

    ''///Select the color by name (8 available)
    ''///vbBlack, vbBlue, vbGreen, vbCyan,
    ''///vbRed, vbMagenta, vbYellow, vbWhite
    lColour = vbRed

    For Each oWs In ThisWorkbook.Worksheets
        Set rToDelete = Nothing
        For Each rCl In oWs.UsedRange
            If rCl.Interior.Color = lColour Then
                If rToDelete Is Nothing Then
                    Set rToDelete = rCl
                Else: Set rToDelete = Union(rToDelete, rCl)
                End If
            End If
        Next
        If Not rToDelete Is Nothing Then rToDelete.Clear
    Next oWs
End Sub

Select allOpen in new window

thank you all.   Sam's solution works like a dream but for a very large spreadsheet does take awhile.  Roy...I couldn't get your version to remove the affected cells.  I have attached a sample file if that is helpful!?

I can't see the example file.

I tested it on a small workbook and it worked like lightening.

It ran but the red text remained.   It is red=255.  Don’t know if that helps

perfect.  Thank you both.

Pleased to help

Quick follow up question...I would like to include your VBA solution in the below code:

Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xls*"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(Filename:=myPath & myFile)
   
    'Ensure Workbook has opened before moving on to next line of code
      DoEvents
   
    'Change First Worksheet's Background Fill Blue
      wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)
   
    'Save and Close Workbook
      wb.Close SaveChanges:=True
     
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents

    'Get next file name
      myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Any ideas how I could do that?  This option would sweep through a directory and format the cells according to your code above.

To use Roy's code when looping through the files, simply replace:

    'Change First Worksheet's Background Fill Blue
      wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)

Select allOpen in new window

with:

' Call routine to delete red cells
DeleteColouredCells

Select allOpen in new window

Thank you Roy.  No error messages but red cells still remain.  Any thoughts?

I assume the affected fille would save with a new time date stamp?  Thank you.

The code above  doesn't saveas, it saves changes. If you want create a new file then you need to use SaveAS