How to use Range.ClearContents() within a Application.Evaluate() context in Excel2010 - excel

Question

The ClearContents() method appears to be broken inside an Evaluate() context
minimal testing example
Dim ForceRunOnceTogg As Boolean
Public Sub cc_test()
Dim s As Range: Set s = Selection.Cells(1)
ForceRunOnceTogg = False
Evaluate Replace("cc(%1)", "%1", s.Address)
End Sub
Private Function cc(c As Range)
If ForceRunOnceTogg Then Exit Function
ForceRunOnceTogg = True 'also not sure why eval double fires
Debug.Print "marco" 'show double vs single eval fire
c.Value = "bananas" 'show it has correct cell
c.Interior.ColorIndex = 6 'Yellow
c.AddComment "a comment" 'show can run methods on cell
c.ClearContents ' this specific method doesn't fire?
End Function
I have tried various options to get ClearContents to fire inside the Evaluate, including just passing the address as a string and using set c = Application.Range(addr); however I have yet to find an option where ClearContents is working. Is there maybe a way to workaround ClearContents and still leave the cell in the same state as if it were cleared?
Otherwise, I guess I'm looking at a replacement for Evaluate in my usage case
minimal usage example
Dim ForceRunOnceTogg As Boolean
Private Sub MapSelection(Lambda As String)
Dim r As Range, ar As Range, col As Range
Set r = Selection
Dim i As Long, rowCount As Long, FirstRow As Long, func As String
Dim scrn As Boolean: scrn = Application.ScreenUpdating: Application.ScreenUpdating = False
Dim calc As XlCalculation: calc = Application.Calculation: Application.Calculation = xlCalculationManual
On Error GoTo RestApp
For Each ar In r.Areas
rowCount = ar.Columns(1).Cells.count
FirstRow = ar.Cells(1).Row - 1
For Each col In ar.Columns
For i = 1 To rowCount
If IsEmpty(col.Cells(i)) Then i = col.Cells(i).End(xlDown).Row - FirstRow
If i > rowCount Then Exit For
ForceRunOnceTogg = False
func = Replace(Lambda, "%1", col.Cells(i).Address(External:=False))
' Debug.Print func
Application.Evaluate func
Next i
Next col
Next ar
Application.Calculation = calc: Application.Calculate
Application.ScreenUpdating = scrn
On Error GoTo 0
Exit Sub
RestApp:
Application.Calculation = calc: Application.Calculate
Application.ScreenUpdating = scrn
On Error GoTo 0
Resume
End Sub
Private Function clearJunk_cell(c As Range)
If ForceRunOnceTogg Then Exit Function
ForceRunOnceTogg = True
If IsError(c.Value) Then
c.ClearContents ' ClearContents won't fire in this context
ElseIf c.Value = "" Then
c.ClearContents
ElseIf Strings.Trim(c.Value) = "" Then
c.ClearContents
End If
End Function
Private Function markJunk_cell(c As Range)
If ForceRunOnceTogg Then Exit Function
ForceRunOnceTogg = True
If IsError(c.Value) Then
c.Interior.Color = 16776960 'Bright Blue
ElseIf c.Value = "" Then
c.Interior.Color = 16776960
ElseIf Strings.Trim(c.Value) = "" Then
c.Interior.Color = 16776960
End If
End Function
Public Function ScrubText(text As String) As String
Dim i As Long, T As String, a As Long
For i = 1 To Len(text)
T = Mid(text, i, 1)
a = AscW(T)
If 31 < a And a < 128 Then ScrubText = ScrubText & T
Next i
End Function
Private Function Scrub_cell(c As Range)
If ForceRunOnceTogg Then Exit Function
ForceRunOnceTogg = True
c.Value2 = ScrubText(c.Value2)
End Function
Private Function markScrub_cell(c As Range)
If ForceRunOnceTogg Then Exit Function
ForceRunOnceTogg = True
If c.Value2 <> ScrubText(c.Value2) Then
c.Interior.Color = 16776960 'Bright Blue
End If
End Function
Public Sub clearJunk(): MapSelection "clearJunk_cell(%1)": End Sub
Public Sub markJunk(): MapSelection "markJunk_cell(%1)": End Sub
Public Sub scrubSelection(): MapSelection "Scrub_cell(%1)": End Sub
Public Sub markScrubSelection(): MapSelection "markScrub_cell(%1)": End Sub
Where clearJunk(), markJunk(), scrubSelection(), and markScrubSelection() along with other similar subs are called from ribbon buttons.

Answer 1

Thanks to the comments, it turns out that Application.Run() made for a much cleaner solution.
Enum SpeedSetting: Fastest: Fast: Medium: Slow: End Enum
Public Sub SetSpeedUp(Optional Speed As SpeedSetting = Slow)
Select Case Speed
Case Fastest
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
ActiveSheet.DisplayPageBreaks = False
Case Fast
Application.ScreenUpdating = False
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationManual
ActiveSheet.DisplayPageBreaks = False
Case Medium
Application.ScreenUpdating = False
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
ActiveSheet.DisplayPageBreaks = False
Case Else 'Slow
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
ActiveSheet.DisplayPageBreaks = False
End Select
End Sub
Private Sub Map(CellMacro As String, ApplyToRange As Range, Optional Speed As SpeedSetting = Fastest)
Dim ar As Range, col As Range
Dim i As Long, rowCount As Long, FirstRow As Long, MaxRow As Long
SetSpeedUp Speed
On Error GoTo RestApp
For Each ar In ApplyToRange.Areas
rowCount = ar.Columns(1).Cells.Count
FirstRow = ar.Cells(1).Row - 1
MaxRow = ar.Cells(1).EntireColumn.Cells.count
For Each col In ar.Columns
For i = 1 To rowCount
If IsEmpty(col.Cells(i)) Then i = col.Cells(i).End(xlDown).Row - FirstRow
If i > rowCount Then
Exit For
ElseIf i = MaxRow Then
If IsEmpty(col.Cells(i)) Then Exit For
End If
Application.Run CellMacro, col.Cells(i)
Next i
Next col
Next ar
SetSpeedUp Slow
On Error GoTo 0
Exit Sub
RestApp:
SetSpeedUp Slow
On Error GoTo 0
Resume
End Sub
Public Sub clearJunk(): Map "clearJunk_cell", Selection: End Sub
Private Sub clearJunk_cell(c As Range)
If IsError(c.Value) Then
c.ClearContents
ElseIf c.Value = "" Then
c.ClearContents
ElseIf Strings.Trim(c.Value) = "" Then
c.ClearContents
End If
End Sub
Public Sub markJunk(): Map "markJunk_cell", Selection: End Sub
Private Sub markJunk_cell(c As Range)
If IsError(c.Value) Then
c.Interior.Color = 16776960 'Bright Blue
ElseIf c.Value = "" Then
c.Interior.Color = 16776960
ElseIf Strings.Trim(c.Value) = "" Then
c.Interior.Color = 16776960
End If
End Sub
Public Sub Touch(): Map "touch_cell", Selection: End Sub
Private Sub touch_cell(c As Range)
If Asc(c.Formula) <> 61 Then c.Value = c.Value
End Sub
Public Function ScrubText(text As String) As String
Dim i As Long, T As String, a As Long
For i = 1 To Len(text)
T = Mid(text, i, 1)
a = AscW(T)
If 31 < a And a < 128 Then ScrubText = ScrubText & T
Next i
End Function
Public Sub ScrubSelection(): Map "ScrubText_cell", Selection: End Sub
Private Sub ScrubText_cell(c As Range): c.Value2 = ScrubText(c.Value2): End Sub
Public Sub markScrubSelection(): Map "ScrubText_cell", Selection: End Sub
Private Function markScrub_cell(c As Range)
If c.Value2 <> ScrubText(c.Value2) Then
c.Interior.Color = 16776960 'Bright Blue
End If
End Function