VB code to remove special characters

[sshrikanth2]

Hi,

I need you help....

The following code will remove the special characters from a text line but i need a coding line to be added to this which replace special character "&" with "AND". Also, if there are more than two spaces in a text it should be condensed to only one.

Any help will be appreciated.


Private Sub CommandButton1_Click()
Dim myString As String, ce As Range, i As Long
Application.ScreenUpdating = False
For Each ce In Range("A3:A500")
For i = Len(ce.Value) To 1 Step -1
Select Case Mid(ce.Value, i, 1)
Case Is = "`", "!", "@", "#", "$", ";", "^", "(", ")", "_", "-", "=", "+", _
"{", "[", "}", "]", "\", "|", ";", ":", "'", """", ",", "<", ".", ">", "/", "?"
myString = Replace(ce.Value, Mid(ce.Value, i, 1), "")
ce.Value = myString
' Do Nothing
End Select
Next i
myString = ""

Next ce
Application.ScreenUpdating = True
End Sub

Regards,

Srikanth M

 

[xenou]

Hi, see if this works:

[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Sub[/COLOR] CommandButton1_Click()
[COLOR="Navy"]Dim[/COLOR] myString [COLOR="Navy"]As[/COLOR] String, ce [COLOR="Navy"]As[/COLOR] Range, i [COLOR="Navy"]As[/COLOR] Long, re [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR]

    [COLOR="Navy"]Set[/COLOR] re = CreateObject("VBScript.RegExp")

    Application.ScreenUpdating = False
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] ce [COLOR="Navy"]In[/COLOR] Range("A3:A500")
        [COLOR="Navy"]For[/COLOR] i = Len(ce.Value) [COLOR="Navy"]To[/COLOR] 1 [COLOR="Navy"]Step[/COLOR] -1
            ce.Value = Replace(ce.Value, "&", " AND ")
            ce.Value = Remove_Extra_Spaces(ce.Value, re) [COLOR="SeaGreen"]'//Warning: will return string values (even numeric values are returned as text).[/COLOR]
            [COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] Mid(ce.Value, i, 1)
            [COLOR="Navy"]Case[/COLOR] [COLOR="Navy"]Is[/COLOR] = "`", "!", "@", "#", "$", ";", "^", "(", ")", "_", "-", "=", "+", _
                "{", "[", "}", "]", "\", "|", ";", ":", "'", """", ",", "<", ".", ">", "/", "?"
                myString = Replace(ce.Value, Mid(ce.Value, i, 1), "")
                ce.Value = myString
            [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Select[/COLOR]
        [COLOR="Navy"]Next[/COLOR] i
        myString = ""
    [COLOR="Navy"]Next[/COLOR] ce
    Application.ScreenUpdating = True

    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
    
[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Function[/COLOR] Remove_Extra_Spaces(ByVal arg, [COLOR="Navy"]ByRef[/COLOR] re [COLOR="Navy"]As[/COLOR] Object) [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="SeaGreen"]'//Replace two or more spaces with a single space[/COLOR]
[COLOR="Navy"]Dim[/COLOR] s [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
    
    s = CStr(arg)
    [COLOR="Navy"]With[/COLOR] re
        .Pattern = "[ ]{2,}"
        .Global = True
        [COLOR="Navy"]If[/COLOR] .Test(s) [COLOR="Navy"]Then[/COLOR]
            Remove_Extra_Spaces = .Replace(s, " ")
        [COLOR="Navy"]Else[/COLOR]
            Remove_Extra_Spaces = s
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
    
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Function[/COLOR]

 

[shg]

Another way:

Private Sub CommandButton1_Click()
    Const sBad      As String = "`!@#$;^()_-=+{}[]\|;:'"",.<>/?"
    Dim cell        As Range
    Dim s           As String
    Dim i           As Long   

    Application.ScreenUpdating = False
    For Each cell In Range("A3:A500")
        If VarType(cell.Value) = vbString Then
            s = cell.Value

            For i = 1 To Len(sBad)
                s = Replace(s, Mid(sBad, i, 1), "")
            Next i
            
            cell.Value = Application.Trim(s)
        End If
    Next cell
    
    Application.ScreenUpdating = True
End Sub

 

[sshrikanth2]

Thank you so much...

I have one more problem here, in "column B" i have list of PAN (Permanent Account No.) which should be equal to 9 digits. If not, the zeros should be prefixed to make them 9 digits. Do you happen to know the VB code to execute this function?

Any help will be appreciated.

Following is the list of PAN No. and i have also higlighted the PAN No. in Red for PAN which is less than 9 digits.
​

PAN No.​ ​ ​ ​ ​ ​ ​ ​ ​ ​ ​

961115037​ ​ ​ ​ ​ ​ ​ ​ ​ ​

776038326​ ​ ​ ​ ​ ​ ​ ​ ​ ​

75698453​ ​ ​ ​ ​ ​ ​ ​ ​ ​ ​

984526693​ ​ ​ ​ ​ ​ ​ ​ ​ ​

345​ ​ ​ ​ ​ ​ ​ ​ ​ ​ ​

330677969​ ​ ​ ​ ​ ​ ​ ​ ​ ​

520671859​ ​ ​ ​ ​ ​ ​ ​ ​ ​

123​ ​ ​ ​ ​ ​ ​ ​ ​ ​ ​

458963​ ​ ​ ​ ​ ​ ​ ​ ​ ​ ​

456123897​ ​ ​ ​ ​ ​ ​ ​ ​ ​

<TBODY> </TBODY>

Regards,

Srikanth M

 

[ZVI]

You can format cells in B-column as follows:
Right click | Format cells | Custom (in Number tab) | 000000000 | OK

 

[mlo356]

Another way:

Private Sub CommandButton1_Click()
    Const sBad      As String = "`!@#$;^()_-=+{}[]\|;:'"",.<>/?"
    Dim cell        As Range
    Dim s           As String
    Dim i           As Long   

    Application.ScreenUpdating = False
    For Each cell In Range("A3:A500")
        If VarType(cell.Value) = vbString Then
            s = cell.Value

            For i = 1 To Len(sBad)
                s = Replace(s, Mid(sBad, i, 1), "")
            Next i
            
            cell.Value = Application.Trim(s)
        End If
    Next cell
    
    Application.ScreenUpdating = True
End Sub

Hi. I know this is an old thread but could this be turned into a UDF?

Thanks!!

 

[xenou]

probably not. UDF (technically) need to return a value. they would have to be able to take the form =MyUDF(). This subroutine is not returning a value. In other words, you cannot put an equals sign in front of it.

It could be a UDF, if, for instance, you wanted the value of a cell to be the changed result of a value in another cell. For instance, in Cell B1:
=MyUDF(A1)

 

[ZVI]

Can be like this:

Function CleanUp(Txt As String) As String' Example of the cell formula: = cLEANuP(A1)  Const sGoodChars = "A-Za-z0-9%&\*\s\n" ' where "\*" is "*", "\s" is white spaces, "\n" is vbLf  Static oRegEx As Object  If oRegEx Is Nothing Then    Set oRegEx = CreateObject("VBScript.RegExp")    oRegEx.Global = True  End If  With oRegEx    .Pattern = "[^" & sGoodChars & "]"    CleanUp = .Replace(Txt, vbNullString)    .Pattern = " " & " +"    CleanUp = Trim(.Replace(CleanUp, " "))  End WithEnd Function

 

[ZVI]

Can be like this:

Below is the same code of UDF as in my previous post but with correct formatting:

Function CleanUp(Txt As String) As String
' Example of the cell formula: =CleanUp(A1)
  Const sGoodChars = "A-Za-z0-9%&\*\s\n" ' where "\*" is "*", "\s" is white spaces, "\n" is vbLf
  Static oRegEx As Object
  If oRegEx Is Nothing Then
    Set oRegEx = CreateObject("VBScript.RegExp")
    oRegEx.Global = True
  End If
  With oRegEx
    .Pattern = "[^" & sGoodChars & "]"
    CleanUp = .Replace(Txt, vbNullString)
    .Pattern = " " & " +"
    CleanUp = Trim(.Replace(CleanUp, " "))
  End With
End Function