How to remove diacritical marks

Have you ever deal with diacritical marks? Some languages contain characters with diacritical marks, even English language. To replace these characters with their regular equivalents two string constants are usually used. The first one contains the characters with diacritical marks (something like "äáâăąćçčďđëéěęíîĺľłńňöóôőŕřśşšťţüúůűýżźž") and the second one contains the characters to replace them ("aaaaacccddeeeeiilllnnoooorrsssttuuuuyzzz"). This method is available on the Internet and there is no problem to find it. For the proper functioning of this method the first string constant must contain all potential characters with diacritical marks. A piece of cake, right? But is there a possibility to do it without this condition? Yes, there is and I found it.

The solution is quite simple, actually. Just read the help for the MATCH function. If argument match_type is 1 or omitted, the function finds the largest value that is less than or equal to lookup_value.
Here is the formula that the solution is based on:

Select all

=IFERROR(CHAR(CODE("A")-1+MATCH(char,{"A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z"})+IF(ISERROR(FIND(LOWER(char),char)),0,32)),char)

The first part - MATCH - looks a particular character up and the second - FIND - converts it to a large/small according to the original.
You can download the workbook with a few examples here.

In the VBA

The formula is the solution for worksheets. However, this problem is mostly solved within the VBA project. Look at the UDF below, where I show how you can use this method in the VBA subroutines.

Select all

Function REMOVE_DIACRITICS(vValue)
  Dim sRetValue As String
  sRetValue = vbNullString
  
  Dim bIsString As Boolean
  bIsString = TypeName(vValue) = "String"
  If Not bIsString Then
    If TypeName(vValue) = "Range" Then
      bIsString = TypeName(vValue.Value) = "String"
    End If
  End If
  
  If bIsString Then
    Dim sOrigString As String
    sOrigString = vValue
    
    Dim sChars() As String
    sChars = Split("A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z", ",")
    
    Dim sRetString As String
    sRetString = sOrigString
    
    Dim iChar As Long
    For iChar = 0 To UBound(sChars)
      If Not InStr(sOrigString, sChars(iChar)) = 0 Then
        sOrigString = Replace(sOrigString, sChars(iChar), vbNullString)
      End If
      If Not InStr(sOrigString, LCase(sChars(iChar))) = 0 Then
        sOrigString = Replace(sOrigString, LCase(sChars(iChar)), vbNullString)
      End If
    Next iChar
    
    Dim sCharOrig As String * 1, sCharNew As String * 1
    While Not Len(sOrigString) = 0
      sCharOrig = Left$(sOrigString, 1)
      If Not StrComp(UCase(sCharOrig), LCase(sCharOrig), vbBinaryCompare) = 0 Then
        sCharNew = Chr(64 + WorksheetFunction.Match(sCharOrig, sChars) - 32 * (StrComp(UCase(sCharOrig), sCharOrig, vbBinaryCompare)))
      Else
        sCharNew = sCharOrig
      End If
      
      If Not sCharNew = sCharOrig Then
        sRetString = Replace(sRetString, sCharOrig, sCharNew)
      End If
      sOrigString = Replace(sOrigString, sCharOrig, vbNullString)
    Wend
  
    REMOVE_DIACRITICS = sRetString
  Else
    REMOVE_DIACRITICS = vValue
  End If
End Function

Tweet