VBA Help

Mikeos145

New Member
Joined
Nov 26, 2015
Messages
5
Hi,

I need to run some VBA code to clean Column D on various workbooks.

Column D contains a load of names from websites/apps with a load of non-Alpha characters.

I have found the below two functions online which are perfect for what I need to do. However they need to be done in order, first removing the accents, then removing all but required characters.

Furthermore, I was hoping there was a way I could just run the code to clean column D, rather than currently where it creates two functions which I then need to use and copy and paste the results back into column D. I haven't used VBA for a long time but I remember when I did I just hit F5 and actions were taken onto the current workbook.

Any help will be greatly appreciated. Here are the following :

Function StripAccent(thestring As String)
Dim A As String * 1
Dim B As String * 1
Dim i As Integer
Const AccChars = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
For i = 1 To Len(AccChars)
A = Mid(AccChars, i, 1)
B = Mid(RegChars, i, 1)
thestring = Replace(thestring, A, B)
Next
StripAccent = thestring
End Function
Sub stripper()


End Sub


Function CleanCode(Rng As Range)
Dim strTemp As String
Dim n As Long


For n = 1 To Len(Rng)
Select Case Asc(Mid(UCase(Rng), n, 1))
Case 32, 46, 48 To 57, 65 To 90
strTemp = strTemp & Mid(UCase(Rng), n, 1)
End Select
Next
CleanCode = strTemp
End Function
Sub cleanrr()





 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Your second function is leaking characters :warning:
- I have not investigated but spotted (by chance) that space & = disappear when the 2nd function is run
- it happens in your posted function before any of my changes, so do not blame me :eeek:
- in future please remember to click on the # icon above post window and paste your code between the code tags that appear

Try this
- a few things amended in your 2 functions for consistency
- data to be cleaned assumed to be D2 downwards
- by placing one function inside the other, the outside function uses the string returned by the inside function
Code:
 [I]but is exactly the same result as writing the returned value to the cell (or variabe) and then applying the second function like this:[/I]
        cel.Value = StripAccent(cel.Value)
        cel.Value = CleanCode(cel.Value)



Code:
[B]Sub TidyUpColumnD[/B]()
    Dim cel As Range
    For Each cel In Range("D2", Range("D" & Rows.Count).End(xlUp))
        cel.Value = CleanCode(StripAccent(cel.Value))
    Next
End Sub

Code:
[B]Function StripAccent[/B](theString As String) As String
    Dim A As String, B As String, i As Integer

    Const AccChars = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
    Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
    For i = 1 To Len(AccChars)
       A = Mid(AccChars, i, 1)
       B = Mid(RegChars, i, 1)
       theString = Replace(theString, A, B)
    Next i
    StripAccent = theString
End Function

Code:
[B]Function CleanCode[/B](theString As String) As String
    Dim strTemp As String, n As Long
    For n = 1 To Len(theString)
        Select Case Asc(Mid(UCase(theString), n, 1))
            Case 32, 46, 48 To 57, 65 To 90
                strTemp = strTemp & Mid(UCase(theString), n, 1)
        End Select
    Next n
    CleanCode = strTemp
End Function
 
Last edited:
Upvote 0
Code:
Sub CombinedClean()
    Dim A As String * 1
    Dim B As String * 1
    Dim i As Integer
    Dim rngCell As Range
    Dim n As Long
    Dim sString As String
    Dim sTemp As String
    
    'Replace accented characters with unaccented
    Const AccChars = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
    Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
    For i = 1 To Len(AccChars)
        A = Mid(AccChars, i, 1)
        B = Mid(RegChars, i, 1)
        Columns("D:D").Replace What:=A, Replacement:=B, LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
    Next
    
    'Force uppercase and remove all but  <space>  .  0-9   A-Z
    For Each rngCell In Columns("D:D").SpecialCells(xlCellTypeConstants, 23)
        sString = UCase(rngCell.Value)
        For n = 1 To Len(sString)
            Select Case Asc(Mid(sString, n, 1))
            Case 32, 46, 48 To 57, 65 To 90
                sTemp = sTemp & Mid(sString, n, 1)
            End Select
        Next
        rngCell.Value = sTemp
        sTemp = vbNullString
    Next
    
End Sub
</space>
 
Upvote 0

Forum statistics

Threads
1,223,099
Messages
6,170,107
Members
452,302
Latest member
TaMere

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