Okay, sorted it out.
Basically, for reasons that are unknown to me, cells that were 'numbers stored as text' but formatted in Excel as 'Dates' rather than as 'Text'; were still getting picked up by the following bit of code:
RangeIn.SpecialCells(xlConstants, xlTextValues)
When one of these cells was encountered, as soon as it was trimmed or cleaned, it would automatically revert to being a 'number' rather than 'numbers stored as text'; naturally this caused errors with the following function calls on a cell that is no longer an xlConstants, xlTextValues cell.
My solution isn't elegant, basically what it does is change the format of all cells within the calculated IntersectRng, to text (via IntersectRng.NumberFormat = "@"). The rest of the code then works again. This may or may not be acceptable for others, but that's where I have left it at.
I've left in the functionality to skip data validation cells, though it doesn't actually seem to be a problem to clean and trim them (as I originally thought). Note that if you skip cells with data validation, this is dependent on other code that I sourced from the previous links (the codes provides a function to calculate a complement range when given two range arguments). I have reposted this code below, but it's nothing of mine, I just whacked it in and used it.
In summary: you only need the extra functions if you set the SkipValidation argument to True; if that is left as False, the extra functions are not called. The extra functions are:
Public Function Complement
Public Function Union
So here is the main cleaning code as it currently stands:
Option Explicit
' An enumeration to allow for bitwise option selection - uses base 2, aka: binary
Enum CleanType
ReplaceItOnly = 0
SizeIt = 2 ^ 0
TextToNumIt = 2 ^ 1
TrimIt = 2 ^ 2
CleanIt = 2 ^ 3
ProperIt = 2 ^ 4
PrefixCharIt = 2 ^ 5
FormatIt = 2 ^ 6
End Enum
Public Sub TrimAll(RangeIn As Range, Optional CleaningMode As CleanType = 76, Optional Length As Integer = 255, Optional ReplacementCode As Integer = 42, Optional SkipValidation As Boolean = False)
Dim Cell As Range, IntersectRng As Range, ValidationRng As Range, TextConstRng As Range
Dim i As Integer
Dim CurrentProgressValue As Double, CountCellsInRanges As Double, CheckValue As Double, PercentChange As Double
Dim CodesToReplace() As Variant
Dim temp As String
On Error GoTo STOPPER
' Initialise character codes to be replaced
CodesToReplace() = Array(127, 129, 141, 143, 144, 157, 160)
For i = LBound(CodesToReplace) To UBound(CodesToReplace)
' Display progress information in status bar
Application.StatusBar = "Currently on worksheet: """ & RangeIn.Parent.Name & """ - Replacement in Progress: """ & i & " of " & UBound(CodesToReplace) & ": " & Format(i / UBound(CodesToReplace), "Percent") & """ - Macro Is Still Running!"
' Convert all extra codes to the ReplacementCode character for trimming by other functions or other means in Excel
RangeIn.Replace What:=Chr(CodesToReplace(i)), Replacement:=Chr(ReplacementCode), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
' On Error Resume Next 'in case no text cells in selection
Next i
' If no further cleaning has been specified
If CleaningMode And ReplaceItOnly Then Exit Sub
' Display progress information in status bar
Application.StatusBar = "Currently on worksheet: """ & ActiveSheet.Name & """ - Calculating which cells are text values out of the " & Format(RangeIn.Cells.count, "#,##0") & _
" that were passed for further processing - This might take some time, but THE MACRO IS STILL RUNNING!"
' Set the intersection range, deciding whether or not to include cells with validation that may be violated.
If SkipValidation Then
Set ValidationRng = Intersect(RangeIn, RangeIn.SpecialCells(xlCellTypeAllValidation))
Set TextConstRng = Intersect(RangeIn, RangeIn.SpecialCells(xlConstants, xlTextValues))
Set IntersectRng = Complement(TextConstRng, ValidationRng)
Else
Set IntersectRng = Intersect(RangeIn, RangeIn.SpecialCells(xlConstants, xlTextValues))
End If
' No cells were found containing constants of type a text value type, so exit
If IntersectRng Is Nothing Then Exit Sub
' Set all cell formats to confirm they will stay as text throughout
' .SpecialCells(xlConstants, xlTextValues) seems to be selecting cells that are formatted as 'Date'
If CleaningMode And FormatIt Then IntersectRng.NumberFormat = "@"
' Initialise the required counter variables
CountCellsInRanges = IntersectRng.Cells.count
CurrentProgressValue = 0
CheckValue = 0
For Each Cell In IntersectRng
With Cell
' Perform the CleaningMode operations.
If CleaningMode And SizeIt Then .Value = Left(.Value, Length)
If CleaningMode And PrefixCharIt Then .Value = .Value
If CleaningMode And TextToNumIt Then .Value = .Value * 1
If CleaningMode And TrimIt Then .Value = Application.WorksheetFunction.Trim(.Value)
If CleaningMode And CleanIt Then .Value = Application.WorksheetFunction.Clean(.Value)
If CleaningMode And ProperIt Then .Value = Application.WorksheetFunction.Proper(.Value)
End With
' Only update on a full percent change
PercentChange = 100 * CurrentProgressValue \ CountCellsInRanges
If CheckValue <> PercentChange Then
CheckValue = PercentChange
Application.StatusBar = "Currently on worksheet: '" & RangeIn.Parent.Name & "' - Cleaning in Progress: '" _
& CurrentProgressValue & " of " & CountCellsInRanges & ": " & _
Format(CheckValue, "#0\%") & "' - Macro Is Still Running!"
End If
' Stop every 10% for system event execution
If CheckValue Mod 10 = 0 Then
DoEvents
End If
' Iterate the progress counter
CurrentProgressValue = CurrentProgressValue + 1
Next Cell
STOPPER:
MsgBox "Error encountered, debugging needed."
Exit Sub
End Sub
Public Sub Call_TrimAll_Selection()
'uses bitwise (base 2) enumerated CleanType data type, so options can be added together
Dim bStatusBar As Boolean
' store state of status bar, and then show it so progress of function can be seen
bStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
' prep for long macro to run
Application.Cursor = xlWait
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Call TrimAll(Selection)
'Clear the status bar and restore its original state.
Application.StatusBar = False
Application.DisplayStatusBar = bStatusBar
' Restore after long macro
Application.ScreenUpdating = True
Application.Cursor = xlDefault
Application.Calculation = xlCalculationAutomatic
Application.CalculateFullRebuild
End Sub
Public Sub Call_TrimAll_Workbook()
'uses bitwise (base 2) enumerated CleanType data type, so options can be added together
Dim Cell As Range, OriginalCell As Range, WSCell As Range
Dim CodesToReplace() As Integer, i As Integer, CurrentProgressValue As Integer
Dim WS As Worksheet, OriginalWS As Worksheet
Dim bStatusBar As Boolean
' store state of status bar, and then show it so progress of function can be seen
bStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
' prep for long macro to run
Application.Cursor = xlWait
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
' Store the original position prior to running
Set OriginalCell = ActiveCell
Set OriginalWS = ActiveSheet
For Each WS In Worksheets
WS.Activate
Set WSCell = ActiveCell
Range("A1").Select
Range(Selection, Selection.SpecialCells(xlLastCell)).Select
Call TrimAll(Selection)
WSCell.Select
' Allow system to do events, then get VBA to wait for some number of seconds to aid stability
DoEvents
Application.Wait (Now() + CDate("00:00:01"))
Next WS
OriginalWS.Activate
OriginalCell.Select
'Clear the status bar and restore its original state.
Application.StatusBar = False
Application.DisplayStatusBar = bStatusBar
' Restore after long macro
Application.ScreenUpdating = True
Application.Cursor = xlDefault
Application.Calculation = xlCalculationAutomatic
Application.CalculateFullRebuild
End Sub
And here are the extra functions (not mine originally, or even modded by me) to allow for the SkipValidation functionality:
'(needed by the 2nd function)Public Function Union(ByRef rng1 As Range, _
ByRef rng2 As Range) As Range
If rng1 Is Nothing Then
Set Union = rng2
Exit Function
End If
If rng2 Is Nothing Then
Set Union = rng1
Exit Function
End If
If Not rng1.Worksheet Is rng2.Worksheet Then
Exit Function
End If
Set Union = Application.Union(rng1, rng2)
End Function
Public Function Complement(ByRef rng1 As Range, _
ByRef rng2 As Range) As Range
Dim rngResult As Range
Dim rngResultCopy As Range
Dim rngIntersection As Range
Dim rngArea1 As Range
Dim rngArea2 As Range
Dim lngTop As Long
Dim lngLeft As Long
Dim lngRight As Long
Dim lngBottom As Long
If rng1 Is Nothing Then
Exit Function
End If
If rng2 Is Nothing Then
Set Complement = rng1
Exit Function
End If
If Not rng1.Worksheet Is rng2.Worksheet Then
Exit Function
End If
Set rngResult = rng1
For Each rngArea2 In rng2.Areas
If rngResult Is Nothing Then
Exit For
End If
Set rngResultCopy = rngResult
Set rngResult = Nothing
For Each rngArea1 In rngResultCopy.Areas
Set rngIntersection = Application.Intersect(rngArea1, rngArea2)
If rngIntersection Is Nothing Then
Set rngResult = Union(rngResult, rngArea1)
Else
lngTop = rngIntersection.row - rngArea1.row
lngLeft = rngIntersection.Column - rngArea1.Column
lngRight = rngArea1.Column + rngArea1.Columns.count - rngIntersection.Column - rngIntersection.Columns.count
lngBottom = rngArea1.row + rngArea1.Rows.count - rngIntersection.row - rngIntersection.Rows.count
If lngTop > 0 Then
Set rngResult = Union(rngResult, rngArea1.Resize(lngTop, rngArea1.Columns.count))
End If
If lngLeft > 0 Then
Set rngResult = Union(rngResult, rngArea1.Resize(rngArea1.Rows.count - lngTop - lngBottom, lngLeft).Offset(lngTop, 0))
End If
If lngRight > 0 Then
Set rngResult = Union(rngResult, rngArea1.Resize(rngArea1.Rows.count - lngTop - lngBottom, lngRight).Offset(lngTop, rngArea1.Columns.count - lngRight))
End If
If lngBottom > 0 Then
Set rngResult = Union(rngResult, rngArea1.Resize(lngBottom, rngArea1.Columns.count).Offset(rngArea1.Rows.count - lngBottom, 0))
End If
End If
Next rngArea1
Next rngArea2
Set Complement = rngResult
End Function
.
