Is there a faster way to replace accented characters?

Question

I have this code that replaces all accented characters except in row 6. However, this macro takes a long time because it goes through every cell/letter, is there any way to make this any faster by making it ignore cells that don't have any accents in them?

Const sFm As String = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const sTo As String = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"

Dim i As Long, employeews As Worksheet
Dim rowsix() As Variant

Set employeews = DestWb.Sheets(1)

'Don't replace row 6
rowsix = employeews.Rows(6).Value


For i = 1 To Len(sFm)
    employeews.Cells.Replace Mid(sFm, i, 1), Mid(sTo, i, 1), LookAt:=xlPart, MatchCase:=True
Next i

employeews.Rows(6).Value = rowsix

Answer 1

Putting comment as an answer so the code is more readable:

---

I would think to choose a range I want to replace values within, then loop through the special characters to replace, as a whole, within the range. The only real caveat to remember is that this will affect formulas.

dim accentArr as variant, noAccentArr as variant
'accent and noaccent need to have same upper bound for this approach!
accentArr = Array("Š","Ž","š") 'quick mockup
noAccentArr = Array("S","Z","s") 
dim i as long
For i = lbound(accentArr) to ubound(accentArr)
    ws.range("a1:z5").replace(accentArr(i),noAccentArr(i))
Next i

Rather than going character by character in the cell, you at least do a mass replace for specific characters... this also allows your Range() to start at row 7, as to not include row 6.

---

Postscript, see: Split string into array of characters? if you want to utilize the existing string without having to manually split out the string of characters into an array.

Answer 2

In line with what everyone else is saying, and not really knowing what you are considering as bad performance, you could try someting like so. It uses a dictionary which is populated with your from and to strings, split into characters and their replacements where the from is the key and the to is the item The keys() and items() of the dictionary are array's so using them rather than slicing the string each time and the dictionary will be available again.

Private d As Scripting.Dictionary

Const sFrom As String = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const sTo As String = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"

Sub PopulateReplacements()

Dim s As String
Dim l As Long

Set d = New Scripting.Dictionary

For l = 1 To Len(sFrom)
    If Not d.Exists(Mid(sFrom, l, 1)) Then _
                d.Add Mid(sFrom, l, 1), Mid(sTo, l, 1)
Next l

End Sub

Sub TestReplacing()

Dim s As String
Dim l As Long

s = "ÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔ"
s = "_Ÿ_À_Á_Â_Ã_Ä_Å_Ç_È_É_Ê_Ë_Ì_Í_Î_Ï_Ð_Ñ_"
s = sFrom

If d Is Nothing Then
    PopulateReplacements
End If

For l = 0 To UBound(d.Keys())
    s = Replace(s, d.Keys()(l), d.Items()(l))
Next l

Debug.Print s

End Sub