VBA Help

[Mikeos145]

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()

 

[Yongle]

Your second function is leaking characters
- 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
- 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

 [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)

[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

[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

[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

 

[pbornemeier]

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>