First of all, you should always use Option Explicit at the top of your modules so that it forces you to declare all variables properly.
There is no need to loop through an entire column. Only loop through cells that actually have values. For that we can use the Worksheet.UsedRange property and do an Intersect with the desired range.
Also code should be able to ignore errors and numbers since you are only interested in texts.
Also, there is no need to read the cell value multiple times so best is to read them just once using an array. A With construct can help in reading the cell font colors easily.
Here is what I came up with - kept the original method name:
Option Explicit
Public Sub DeleteComments(ByVal rng As Range)
Dim tempRng As Range
Dim tempArea As Range
Set tempRng = GetUsedRange(rng)
If tempRng Is Nothing Then Exit Sub
'Store app state and turn off some features
Dim scrUpdate As Boolean: scrUpdate = Application.ScreenUpdating
Dim calcMode As XlCalculation: calcMode = Application.Calculation
Dim evEnabled As Boolean: evEnabled = Application.EnableEvents
With Application
If .ScreenUpdating Then .ScreenUpdating = False
If calcMode <> xlCalculationManual Then .Calculation = xlCalculationManual
If .EnableEvents Then .EnableEvents = False
End With
'Loop through all areas. Check/update only relevant values
For Each tempArea In tempRng.Areas
If tempArea.Count = 1 Then
UpdateCell tempArea, tempArea.Value2
Else
Dim arr() As Variant: arr = tempArea.Value2 'Read whole range into array
Dim rowsCount As Long: rowsCount = tempArea.Rows.Count
Dim i As Long: i = 1
Dim j As Long: j = 1
Dim v As Variant
'For Each... loop is faster than using 2 For... Next loops on a 2D array
For Each v In arr 'Column-major order
If VarType(v) = vbString Then 'Only check strings - ignore numbers and errors
If Len(v) > 0 Then UpdateCell tempArea.Cells(i, j), v
End If
i = i + 1
If i > rowsCount Then 'Switch to the next column
j = j + 1
i = 1
End If
Next v
End If
Next tempArea
'Restore app state
With Application
If scrUpdate Then .ScreenUpdating = True
If calcMode <> xlCalculationManual Then .Calculation = calcMode
If evEnabled Then .EnableEvents = True
End With
End Sub
Private Function GetUsedRange(ByVal rng As Range) As Range
If rng Is Nothing Then Exit Function
On Error Resume Next
Set GetUsedRange = Intersect(rng, rng.Worksheet.UsedRange)
On Error GoTo 0
End Function
Private Function UpdateCell(ByVal cell As Range, ByVal value As Variant)
Dim textOut As String
Dim charExcluded As Boolean
Dim i As Long
For i = 1 To Len(value)
With cell.Characters(i, 1).Font
If (.ColorIndex = 1 Or .ColorIndex = -4105) And Not .Strikethrough Then
textOut = textOut & Mid$(value, i, 1)
Else
charExcluded = True
End If
End With
Next i
If charExcluded Then cell.Value2 = textOut
If IsNull(cell.Font.ColorIndex) Then
cell.Font.ColorIndex = 1
ElseIf cell.Font.ColorIndex <> 1 Then
cell.Font.ColorIndex = 1
End If
End Function
As you can see, I've split the code in a few auxiliary functions so that is easier to maintain.
To use it just call it on the desired range. For example:
DeleteComments Selection 'if you already have a selected range
'Or
DeleteComments Range("M:M") 'as in your original post
An added benefit is that this code works regardless if your desired range is a column, a row, multiple columns/rows or even multi-area ranges. Gives you a lot of flexibility and is as fast as you could make it.
Edit #1
The UpdateCell function could be faster if we only check cells with mixed colors:
Private Function UpdateCell(ByVal cell As Range, ByVal value As Variant)
Dim textOut As String
Dim charExcluded As Boolean
Dim i As Long
If IsNull(cell.Font.ColorIndex) Then
For i = 1 To Len(value)
With cell.Characters(i, 1).Font
If (.ColorIndex = 1 Or .ColorIndex = -4105) And Not .Strikethrough Then
textOut = textOut & Mid$(value, i, 1)
Else
charExcluded = True
End If
End With
Next i
If charExcluded Then cell.Value2 = textOut
cell.Font.ColorIndex = 1
ElseIf cell.Font.ColorIndex <> 1 Then
cell.Value2 = Empty
cell.Font.ColorIndex = 1
End If
End Function
