Option Explicit
' An enumeration to allow for bitwise option selection - uses base 2, aka: binary
Enum CleanType
Size = 2 ^ 0
TextToNum = 2 ^ 1
Trim = 2 ^ 2
Clean = 2 ^ 3
Proper = 2 ^ 4
End Enum
Public Sub TrimAll(RangeIn As Range, Optional CleaningMode As CleanType = 12, Optional ReplaceOnly As Boolean = False, _
Optional Length As Integer = 255, Optional ReplacementCode As Integer = 32, Optional bCompleteStatus As Boolean = True)
Dim Cell As Range, IntersectRng As Range
Dim Index As Integer
Dim CurrentProgressValue As Double, NumCells As Double, NumCellRanges As Double
Dim CodesToReplace() As Variant
Select Case bCompleteStatus
' A version that requires more calculation, but provides more feedback to the user through the status bar.
Case True
' Reinitialise the progress variable for status bar message
CurrentProgressValue = 0
' Initialise character codes to be replaced
CodesToReplace() = Array(127, 129, 141, 143, 144, 157, 160)
For Index = LBound(CodesToReplace) To UBound(CodesToReplace)
' Display progress information in status bar
Application.StatusBar = "Currently on worksheet: """ & ActiveSheet.Name & """ - Replacement in Progress: """ & CurrentProgressValue & " of " & UBound(CodesToReplace) & ": " & Format(CurrentProgressValue / 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(Index)), Replacement:=Chr(ReplacementCode), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
On Error Resume Next 'in case no text cells in selection
' Iterate the progress counter
CurrentProgressValue = CurrentProgressValue + 1
Next Index
' Display progress information in status bar
NumCells = RangeIn.Cells.count
If NumCells > 100000 Then
Application.StatusBar = "Currently on worksheet: """ & ActiveSheet.Name & """ - Calculating which cells are text values out of the " & Format(NumCells, "#,##0") & _
" that were passed for further processing - This might take some time, but THE MACRO IS STILL RUNNING!"
Else
Application.StatusBar = "Currently on worksheet: """ & ActiveSheet.Name & """ - Calculating which cells are text values for further processing - Macro Is Still Running!"
End If
' Reinitialise the progress variable for status bar message
CurrentProgressValue = 0
Set IntersectRng = Intersect(RangeIn, RangeIn.SpecialCells(xlConstants, xlTextValues))
NumCellRanges = IntersectRng.Cells.count
' Allow system to do events to aid stability if the passed cell range is larger than some amount
If NumCells > 100000 Then
DoEvents
End If
If Not ReplaceOnly Then
For Each Cell In IntersectRng
' Stop every X number of cells and hand over control to system to execute commands - to aid in stability and progress count
If CurrentProgressValue Mod 50000 = 0 Then
' Allow system to do events, then get VBA to wait for some number of seconds to aid stability
DoEvents
' Uncomment the line below to add wait time if required, the current config adds one second of wait time.
'Application.Wait (Now() + CDate("00:00:01"))
End If
' Display progress information in status bar every so often as determined by calculation.
If CurrentProgressValue Mod 5000 = 0 Then
Application.StatusBar = "Currently on worksheet: """ & ActiveSheet.Name & """ - Cleaning in Progress: """ & CurrentProgressValue & " of " & NumCellRanges & ": " & Format(CurrentProgressValue / NumCellRanges, "Percent") & """ - Macro Is Still Running!"
End If
If CleaningMode And Size Then
Cell.Value = Left(Cell.Value, Length)
End If
If CleaningMode And TextToNum Then
Cell.Value = Cell.Value * 1
End If
If CleaningMode And Trim Then
Cell.Value = Application.WorksheetFunction.Trim(Cell.Value)
End If
If CleaningMode And Clean Then
Cell.Value = Application.WorksheetFunction.Clean(Cell.Value)
End If
If CleaningMode And Proper Then
Cell.Value = Application.WorksheetFunction.Proper(Cell.Value)
End If
' Iterate the progress counter
CurrentProgressValue = CurrentProgressValue + 1
Next Cell
End If
' A version that requires minimal calculation to track progress, but provides less feedback to the user from the status bar.
Case False
' Initialise character codes to be replaced
CodesToReplace = Array(127, 129, 141, 143, 144, 157, 160)
' Display general information in status bar
Application.StatusBar = "Currently on worksheet: """ & ActiveSheet.Name & """ - Replacement in progress - Macro Is Still Running!"
For Index = LBound(CodesToReplace) To UBound(CodesToReplace)
' Convert all extra codes to the ReplacementCode character for trimming by other functions or other means in Excel
RangeIn.Replace What:=Chr(CodesToReplace(Index)), Replacement:=Chr(ReplacementCode), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
On Error Resume Next 'in case no text cells in selection
Next Index
' Allow system to do events to aid stability
DoEvents
' Display general information in status bar
Application.StatusBar = "Currently on worksheet: """ & ActiveSheet.Name & """ - Cleaning in progress - Macro Is Still Running!"
Set IntersectRng = Intersect(RangeIn, RangeIn.SpecialCells(xlConstants, xlTextValues))
If Not ReplaceOnly Then
For Each Cell In IntersectRng
If CleaningMode And Size Then
Cell.Value = Left(Cell.Value, Length)
End If
If CleaningMode And TextToNum Then
Cell.Value = Cell.Value * 1
End If
If CleaningMode And Trim Then
Cell.Value = Application.WorksheetFunction.Trim(Cell.Value)
End If
If CleaningMode And Clean Then
Cell.Value = Application.WorksheetFunction.Clean(Cell.Value)
End If
If CleaningMode And Proper Then
Cell.Value = Application.WorksheetFunction.Proper(Cell.Value)
End If
Next Cell
End If
End Select
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, Clean + Trim)
'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, Index 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, Clean + Trim)
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
Originally Posted by Simple_One
