VBA Remove all Non-Printable and special characters as well as Trim

D

decadence

Well-known Member
Joined
Oct 9, 2015
Messages
525
Office Version
  1. 365
  2. 2016
  3. 2013
  4. 2010
  5. 2007
Platform
  1. Windows
Can someone help me with a macro to combine Removing all Non-Printable and special characters as well as Trim.

I'm using a trim macro at the moment and works great but isn't always removing hidden characters. Also could probably be better than this.

Code: 
Sub Trim()
'
' Trim Macro
' Trim
'
Range("A1").Select
Range(Selection, Selection.SpecialCells(xlLastCell)).Select
Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   Dim cell As Range
   Selection.Replace What:=Chr(160), Replacement:=Chr(32), _
     LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   On Error Resume Next
   For Each cell In Intersect(Selection, _
      Selection.SpecialCells(xlConstants, xlTextValues))
     cell.Value = Application.Trim(cell.Value)
   Next cell
   On Error GoTo 0
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
Range("A1").Select
End Sub

The problem is that My data varies with these issues as the original source of data comes from different people from different places and all come formatted differently. I'm using excel 2007 Thanks in advance
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Sort by date Sort by votes
Thanks, I added it to code and it seems to work, also I removed the application calculation and it seems to work faster without the screen blinking


Code: 
Range("A1").Select
Range(Selection, Selection.SpecialCells(xlLastCell)).Select
Application.ScreenUpdating = False
   Dim cell As Range
   Selection.Replace What:=Chr(160), Replacement:=Chr(32), _
     LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   On Error Resume Next
   For Each cell In Intersect(Selection, _
      Selection.SpecialCells(xlConstants, xlTextValues))
    cell.Value = Application.Trim(cell.Value)
[COLOR="#0000FF"]    cell.Value = Application.WorksheetFunction.Clean(cell.Value)[/COLOR]
   Next cell
   On Error GoTo 0
   Application.ScreenUpdating = True
Range("A1").Select
 
Upvote 0
Here is a UDF (user defined function) that I developed which will clean and trim the text passed into it. The trim operation is identical to Excel's worksheet TRIM function; however, the clean is slightly different. It cleans some additional non-printing characters that Excel's CLEAN function does not handle. Those additional characters are delineated here...

Remove spaces and nonprinting characters from text - Support - Office.com

I also included an optional argument to convert non-breaking spaces (ASCII 160) to real spaces (ASCII 32). Because non-breaking spaces are such a problem when copying text from the web, I defaulted this optional argument to True (meaning non-breaking space will be converted into true spaces and then handled, along with existing spaces, by the trim operation).

Code: 
Function CleanTrim(ByVal S As String, Optional ConvertNonBreakingSpace As Boolean = True) As String
  Dim X As Long, CodesToClean As Variant
  CodesToClean = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, _
                       21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 127, 129, 141, 143, 144, 157)
  If ConvertNonBreakingSpace Then S = Replace(S, Chr(160), " ")
  For X = LBound(CodesToClean) To UBound(CodesToClean)
    If InStr(S, Chr(CodesToClean(X))) Then S = Replace(S, Chr(CodesToClean(X)), "")
  Next
  CleanTrim = WorksheetFunction.Trim(S)
End Function

HOW TO INSTALL UDFs
------------------------------------
If you are new to UDFs, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. You can now use CleanTrim just like it was a built-in Excel function. For example,

=CleanTrim(A1)

If you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.
 
Last edited:
Upvote 0
This is fantastic! I've enhanced Mr. Rothstein's example to fit my needs as shown below. The enhanced function leaves a little room for formatting with Horizontal Tabs, New Lines and Carriage Returns. It allows you to keep these codes when LeadingNonPrintables and/or TrailingNonPrintables is/are True. Perhaps this code could be a little more efficient, but it works well and has been tested on many occasions.

Code: 
'From MrExcel... base code written by Rick Rothstein, MVP
'Builds on the Excel function Clean by replacing various non-printable ASCII characters with "".
'Additionally, for non-breaking spaces, it adds a space and then lets the Trim level deal with the result.
'ASCII Characters for Secondary Clean: Horizontal Tab ~ 9, New Line ~ 10, Carriage Return ~ 13, Non-Breaking Space ~ 160
'9/20/17: Added 2 Optional Arguments to specify "Leading Non-Printable" Characters (before 1st printable charcters) and
'         "Trailing Non-Printables" characters to allow you to essentially shrink the vertical space if and when
'         New Lines, Carriage Returns or Horizontal Tabs are added at the beginning or end of the cell contents
'   FirstChar is the 1st printable character, LastChar is last printable character
Function SmartClean(ByVal S As String, HorizontalTab As Boolean, NewLine As Boolean, CarriageReturn As Boolean, _
                   ConvertNonBreakingSpace As Boolean, Optional LeadingNonPrintables As Boolean, Optional TrailingNonPrintables As Boolean) As Variant
                   Dim X As Integer, A As Boolean, CodesToClean As Variant, FirstChar As Integer, LastChar As Integer, c As Integer
                   Dim myPreSuf As String, myMid As String
                
    If Len(S) = 0 Then
        SmartClean = S
        Exit Function
    End If
    'Change "A" (meaning ALL data) to TRUE if LeadingNonPrintables and TrailingNonPrintables are both false >>> allows us to exit function
    A = False
    
    'CodesToClean initially refers to all non-printable characters that we will eliminate without asking, the last few will be added as specified
    CodesToClean = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 11, 12, 14, 15, 16, 17, 18, 19, 20, _
                         21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 127, 129, 141, 143, 144, 157)
    
    'Deal with ALL Cell Contents: Adds Horizontal Tabs, New Lines and CarriageReturn as specified to the CodesToClean Array
    If LeadingNonPrintables = False And TrailingNonPrintables = False Then
        A = True
        If HorizontalTab Then
            ReDim Preserve CodesToClean(1 To UBound(CodesToClean) + 1)
            CodesToClean(UBound(CodesToClean)) = 9
        End If
        If NewLine Then
            ReDim Preserve CodesToClean(1 To UBound(CodesToClean) + 1)
            CodesToClean(UBound(CodesToClean)) = 10
        End If
        If CarriageReturn Then
            ReDim Preserve CodesToClean(1 To UBound(CodesToClean) + 1)
            CodesToClean(UBound(CodesToClean)) = 13
        End If
    End If
    
    'Convert Non-Breaking Spaces to real spaces first so the rest of the function can handle them accordingly.
    If ConvertNonBreakingSpace Then S = Replace(S, Chr(160), " ")
    
    'Do the basic clean...
    For X = LBound(CodesToClean) To UBound(CodesToClean)
        If InStr(S, Chr(CodesToClean(X))) Then S = Replace(S, Chr(CodesToClean(X)), "")
    Next X
    
    'If A or if S is now a zero length string, no need to continue, otherwize continue on with the the 'partially cleaned' string
    If A Or Len(S) = 0 Then
        SmartClean = S
        Exit Function
    End If
    
    'Given that the data has now been cleaned except for Horizontal Tabs, New Lines and Carriage Returns, downsize CodesToClean!
    If LeadingNonPrintables = True Or TrailingNonPrintables = True Then
        If HorizontalTab = False And NewLine = False And CarriageReturn = False Then    'Everything has already been cleaned as desired
            SmartClean = S
            Exit Function
        End If
        'Clean up the Leading and/or Trailing non-printable characters specified.
        'Part 1: add the space character
        ReDim CodesToClean(1)
        CodesToClean(1) = 32
        'Add the specified non-printables to the CodesToClean. Non-Printable characters remaining are: 9, 10, 13. Code 32 (space) is handled by Trim (outside this function)
        If HorizontalTab Then
            ReDim Preserve CodesToClean(1 To UBound(CodesToClean) + 1)
            CodesToClean(UBound(CodesToClean)) = 9
        End If
        If NewLine Then
            ReDim Preserve CodesToClean(1 To UBound(CodesToClean) + 1)
            CodesToClean(UBound(CodesToClean)) = 10
        End If
        If CarriageReturn Then
            ReDim Preserve CodesToClean(1 To UBound(CodesToClean) + 1)
            CodesToClean(UBound(CodesToClean)) = 13
        End If
        
        'Part 2: Eliminate the Tabs (9), New Lines (10), and Carriage Returns (13) as specified before the 1st printable.
        'Non-Breaking spaces were already handled as desired so ignore them (but don't count them as printable either!)
        'Regular Spaces will be handled by the Trim level as mentioned above.
        If LeadingNonPrintables = True Then
            For X = 1 To Len(S)
                If Not Asc(Mid(S, X, 1)) = 9 And _
                   Not Asc(Mid(S, X, 1)) = 10 And _
                   Not Asc(Mid(S, X, 1)) = 13 And _
                   Not Asc(Mid(S, X, 1)) = 32 And _
                   Not Asc(Mid(S, X, 1)) = 160 Then
                      
                   FirstChar = X                'First Printable Character
                   Exit For
                End If
            Next X
            If FirstChar = 0 Then                                                       'No Printable Characters! No Last Printable Character either.
                'Re-do the basic clean with the newly loaded 'CodesToClean'...
                For X = LBound(CodesToClean) To UBound(CodesToClean)
                    If InStr(S, Chr(CodesToClean(X))) Then S = Replace(S, Chr(CodesToClean(X)), "")
                Next X
                SmartClean = S
                Exit Function
            ElseIf FirstChar = 1 Then
                'No Cleaning at the beginning needed
            ElseIf FirstChar > 1 Then
                myPreSuf = Mid(S, 1, FirstChar - 1)
                myMid = Mid(S, FirstChar, Len(S) - Len(myPreSuf))
                For X = LBound(CodesToClean) To UBound(CodesToClean)                    'Clean the remaining non-printables
                    If CodesToClean(X) = 32 Then
                        'Leave the spaces and let the Trim level deal with them
                    Else
                        If InStr(myPreSuf, Chr(CodesToClean(X))) Then myPreSuf = Replace(myPreSuf, Chr(CodesToClean(X)), "")
                    End If
                Next X
                S = myPreSuf & myMid
            End If
        End If
        LastChar = 0
        If TrailingNonPrintables = False Then
            SmartClean = S
            Exit Function
        ElseIf TrailingNonPrintables = True Then
            For X = Len(S) To 1 Step -1
                If Not Asc(Mid(S, X, 1)) = 9 And _
                   Not Asc(Mid(S, X, 1)) = 10 And _
                   Not Asc(Mid(S, X, 1)) = 13 And _
                   Not Asc(Mid(S, X, 1)) = 32 And _
                   Not Asc(Mid(S, X, 1)) = 160 Then
                   LastChar = X
                   Exit For
                End If
            Next X
            If LastChar = 0 Then                                                        'No Printable Characters
                'Re-do the basic clean with the newly loaded 'CodesToClean'...
                For X = LBound(CodesToClean) To UBound(CodesToClean)
                    If InStr(S, Chr(CodesToClean(X))) Then S = Replace(S, Chr(CodesToClean(X)), "")
                Next X
                SmartClean = S
                Exit Function
            'ElseIf LastChar = Len(S) Then
                'I think this is already handled
            Else
                myPreSuf = Mid(S, LastChar + 1, Len(S) - Len(LastChar))
                myMid = Mid(S, 1, LastChar)
                For X = LBound(CodesToClean) To UBound(CodesToClean)                    'Clean the remaining non-printables
                    If CodesToClean(X) = 32 Then
                        'Leave the spaces and let the Trim level deal with them
                    Else
                        If InStr(myPreSuf, Chr(CodesToClean(X))) Then myPreSuf = Replace(myPreSuf, Chr(CodesToClean(X)), "")
                    End If
                Next X
                SmartClean = myMid & myPreSuf
                Exit Function
            End If
        End If
    Else
        SmartClean = S
        Exit Function
    End If
    SmartClean = "Troubleshoot"                 'This shouldn't happen, but if it does, troubleshoot!
End Function
 
Upvote 0
Code isn't working, It gives me $VALUE Error.

halbmeyer said:
This is fantastic! I've enhanced Mr. Rothstein's example to fit my needs as shown below. The enhanced function leaves a little room for formatting with Horizontal Tabs, New Lines and Carriage Returns. It allows you to keep these codes when LeadingNonPrintables and/or TrailingNonPrintables is/are True. Perhaps this code could be a little more efficient, but it works well and has been tested on many occasions.

Code: 
'From MrExcel... base code written by Rick Rothstein, MVP
'Builds on the Excel function Clean by replacing various non-printable ASCII characters with "".
'Additionally, for non-breaking spaces, it adds a space and then lets the Trim level deal with the result.
'ASCII Characters for Secondary Clean: Horizontal Tab ~ 9, New Line ~ 10, Carriage Return ~ 13, Non-Breaking Space ~ 160
'9/20/17: Added 2 Optional Arguments to specify "Leading Non-Printable" Characters (before 1st printable charcters) and
'         "Trailing Non-Printables" characters to allow you to essentially shrink the vertical space if and when
'         New Lines, Carriage Returns or Horizontal Tabs are added at the beginning or end of the cell contents
'   FirstChar is the 1st printable character, LastChar is last printable character
Function SmartClean(ByVal S As String, HorizontalTab As Boolean, NewLine As Boolean, CarriageReturn As Boolean, _
                   ConvertNonBreakingSpace As Boolean, Optional LeadingNonPrintables As Boolean, Optional TrailingNonPrintables As Boolean) As Variant
                   Dim X As Integer, A As Boolean, CodesToClean As Variant, FirstChar As Integer, LastChar As Integer, c As Integer
                   Dim myPreSuf As String, myMid As String
                
    If Len(S) = 0 Then
        SmartClean = S
        Exit Function
    End If
    'Change "A" (meaning ALL data) to TRUE if LeadingNonPrintables and TrailingNonPrintables are both false >>> allows us to exit function
    A = False
    
    'CodesToClean initially refers to all non-printable characters that we will eliminate without asking, the last few will be added as specified
    CodesToClean = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 11, 12, 14, 15, 16, 17, 18, 19, 20, _
                         21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 127, 129, 141, 143, 144, 157)
    
    'Deal with ALL Cell Contents: Adds Horizontal Tabs, New Lines and CarriageReturn as specified to the CodesToClean Array
    If LeadingNonPrintables = False And TrailingNonPrintables = False Then
        A = True
        If HorizontalTab Then
            ReDim Preserve CodesToClean(1 To UBound(CodesToClean) + 1)
            CodesToClean(UBound(CodesToClean)) = 9
        End If
        If NewLine Then
            ReDim Preserve CodesToClean(1 To UBound(CodesToClean) + 1)
            CodesToClean(UBound(CodesToClean)) = 10
        End If
        If CarriageReturn Then
            ReDim Preserve CodesToClean(1 To UBound(CodesToClean) + 1)
            CodesToClean(UBound(CodesToClean)) = 13
        End If
    End If
    
    'Convert Non-Breaking Spaces to real spaces first so the rest of the function can handle them accordingly.
    If ConvertNonBreakingSpace Then S = Replace(S, Chr(160), " ")
    
    'Do the basic clean...
    For X = LBound(CodesToClean) To UBound(CodesToClean)
        If InStr(S, Chr(CodesToClean(X))) Then S = Replace(S, Chr(CodesToClean(X)), "")
    Next X
    
    'If A or if S is now a zero length string, no need to continue, otherwize continue on with the the 'partially cleaned' string
    If A Or Len(S) = 0 Then
        SmartClean = S
        Exit Function
    End If
    
    'Given that the data has now been cleaned except for Horizontal Tabs, New Lines and Carriage Returns, downsize CodesToClean!
    If LeadingNonPrintables = True Or TrailingNonPrintables = True Then
        If HorizontalTab = False And NewLine = False And CarriageReturn = False Then    'Everything has already been cleaned as desired
            SmartClean = S
            Exit Function
        End If
        'Clean up the Leading and/or Trailing non-printable characters specified.
        'Part 1: add the space character
        ReDim CodesToClean(1)
        CodesToClean(1) = 32
        'Add the specified non-printables to the CodesToClean. Non-Printable characters remaining are: 9, 10, 13. Code 32 (space) is handled by Trim (outside this function)
        If HorizontalTab Then
            ReDim Preserve CodesToClean(1 To UBound(CodesToClean) + 1)
            CodesToClean(UBound(CodesToClean)) = 9
        End If
        If NewLine Then
            ReDim Preserve CodesToClean(1 To UBound(CodesToClean) + 1)
            CodesToClean(UBound(CodesToClean)) = 10
        End If
        If CarriageReturn Then
            ReDim Preserve CodesToClean(1 To UBound(CodesToClean) + 1)
            CodesToClean(UBound(CodesToClean)) = 13
        End If
        
        'Part 2: Eliminate the Tabs (9), New Lines (10), and Carriage Returns (13) as specified before the 1st printable.
        'Non-Breaking spaces were already handled as desired so ignore them (but don't count them as printable either!)
        'Regular Spaces will be handled by the Trim level as mentioned above.
        If LeadingNonPrintables = True Then
            For X = 1 To Len(S)
                If Not Asc(Mid(S, X, 1)) = 9 And _
                   Not Asc(Mid(S, X, 1)) = 10 And _
                   Not Asc(Mid(S, X, 1)) = 13 And _
                   Not Asc(Mid(S, X, 1)) = 32 And _
                   Not Asc(Mid(S, X, 1)) = 160 Then
                      
                   FirstChar = X                'First Printable Character
                   Exit For
                End If
            Next X
            If FirstChar = 0 Then                                                       'No Printable Characters! No Last Printable Character either.
                'Re-do the basic clean with the newly loaded 'CodesToClean'...
                For X = LBound(CodesToClean) To UBound(CodesToClean)
                    If InStr(S, Chr(CodesToClean(X))) Then S = Replace(S, Chr(CodesToClean(X)), "")
                Next X
                SmartClean = S
                Exit Function
            ElseIf FirstChar = 1 Then
                'No Cleaning at the beginning needed
            ElseIf FirstChar > 1 Then
                myPreSuf = Mid(S, 1, FirstChar - 1)
                myMid = Mid(S, FirstChar, Len(S) - Len(myPreSuf))
                For X = LBound(CodesToClean) To UBound(CodesToClean)                    'Clean the remaining non-printables
                    If CodesToClean(X) = 32 Then
                        'Leave the spaces and let the Trim level deal with them
                    Else
                        If InStr(myPreSuf, Chr(CodesToClean(X))) Then myPreSuf = Replace(myPreSuf, Chr(CodesToClean(X)), "")
                    End If
                Next X
                S = myPreSuf & myMid
            End If
        End If
        LastChar = 0
        If TrailingNonPrintables = False Then
            SmartClean = S
            Exit Function
        ElseIf TrailingNonPrintables = True Then
            For X = Len(S) To 1 Step -1
                If Not Asc(Mid(S, X, 1)) = 9 And _
                   Not Asc(Mid(S, X, 1)) = 10 And _
                   Not Asc(Mid(S, X, 1)) = 13 And _
                   Not Asc(Mid(S, X, 1)) = 32 And _
                   Not Asc(Mid(S, X, 1)) = 160 Then
                   LastChar = X
                   Exit For
                End If
            Next X
            If LastChar = 0 Then                                                        'No Printable Characters
                'Re-do the basic clean with the newly loaded 'CodesToClean'...
                For X = LBound(CodesToClean) To UBound(CodesToClean)
                    If InStr(S, Chr(CodesToClean(X))) Then S = Replace(S, Chr(CodesToClean(X)), "")
                Next X
                SmartClean = S
                Exit Function
            'ElseIf LastChar = Len(S) Then
                'I think this is already handled
            Else
                myPreSuf = Mid(S, LastChar + 1, Len(S) - Len(LastChar))
                myMid = Mid(S, 1, LastChar)
                For X = LBound(CodesToClean) To UBound(CodesToClean)                    'Clean the remaining non-printables
                    If CodesToClean(X) = 32 Then
                        'Leave the spaces and let the Trim level deal with them
                    Else
                        If InStr(myPreSuf, Chr(CodesToClean(X))) Then myPreSuf = Replace(myPreSuf, Chr(CodesToClean(X)), "")
                    End If
                Next X
                SmartClean = myMid & myPreSuf
                Exit Function
            End If
        End If
    Else
        SmartClean = S
        Exit Function
    End If
    SmartClean = "Troubleshoot"                 'This shouldn't happen, but if it does, troubleshoot!
End Function
Click to expand...
 
Upvote 0
Hi,

a little comment to #5 :

With RegEx using a few standard lines and the

Code: 
.Pattern ="\W"

could be sufficient.

regards
 
Upvote 0
Small note: This code touches each field and changes text to numbers and removes leading zeroes

Changed CleanTrim = WorksheetFunction.Trim(S)
to
CleanTrim = "'" & WorksheetFunction.Trim(S) to force the field to be text and that appears to work.
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question Question
Completely cleaning account numbers and storing with a specific format
Replies
2
Views
1K
diversification
D
D
  • Question Question
Clean, Trim, or otherwise remove all non-printing characters?
Replies
3
Views
2K
Joe4
Joe4
D
  • Question Question
VBA to Remove Text Characters From Strings
Replies
5
Views
628
Fuji
F
C
  • Solved
VBA to highlight non-English characters in one go based on RGB Color Code
2
Replies
10
Views
502
chingching831
C
D
  • Question Question
VBA to Create Outlook Email Not Working for All Users
Replies
9
Views
287
Logit
Logit

Forum statistics

Threads
1,223,246
Messages
6,170,996
Members
452,373
Latest member
TimReeks

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top