```
'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
```