VBA Loop Cells.Replace Multiple Characters (Case Sensitive)

[zero269]

Hello,

I'm currently using the following code to remove accent characters from a Worksheet:

Sub RemoveAccents()
'Replace Lowercase
    Cells.Replace What:="á", Replacement:="a"
    Cells.Replace What:="é", Replacement:="e"
    Cells.Replace What:="í", Replacement:="i"
    Cells.Replace What:="ó", Replacement:="o"
    Cells.Replace What:="ú", Replacement:="u"
'Replace Uppercase
    Cells.Replace What:="Á", Replacement:="A"
    Cells.Replace What:="É", Replacement:="E"
    Cells.Replace What:="Í", Replacement:="I"
    Cells.Replace What:="Ó", Replacement:="O"
    Cells.Replace What:="Ú", Replacement:="U"
End Sub

I'm looking for a way to loop the code using arrays for both the Accent Characters and the Regular Characters.
I tried using a Function I found online, but that requires using a column to extract and replace the data. This method is a NO GO for me considering the amount of columns and data in many of the cells. A books summary is one example.

I've tried using other examples online, but they either replace characters in all upper or lowercase letters, or they use the active Selection and not the Active Sheet or Table.
Can anyone advise on the best approach to loop this code?
Thank you,

 

[Peter_SSs]

Could you expand on this?

Sub RemoveAccents_v2()
  Dim i As Long

  Const ReplacementList As String = "áaéeÍI"
  
  For i = 1 To Len(ReplacementList) Step 2
    Cells.Replace What:=Mid(ReplacementList, i, 1), Replacement:=Mid(ReplacementList, i + 1, 1)
  Next i
End Sub

 

[zero269]

Could you expand on this?

Sub RemoveAccents_v2()
  Dim i As Long

  Const ReplacementList As String = "áaéeÍI"
 
  For i = 1 To Len(ReplacementList) Step 2
    Cells.Replace What:=Mid(ReplacementList, i, 1), Replacement:=Mid(ReplacementList, i + 1, 1)
  Next i
End Sub

Hi Peter,

Yes, absolutely. I tested it as is and noticed it replaced all with lowercase letters, but I was able to add MatchCase to resolve that.
I added my full length of sample accented characters, and it works perfectly.
Here's your code with the addition of MatchCase:

'https://www.mrexcel.com/board/threads/vba-loop-cells-replace-multiple-characters-case-sensitive.1231586/post-6028845
Sub RemoveAccentMarks()
  Dim i As Long
  Const ReplacementList As String = "ÁAÉEÍIÓOÚUáaéeíióoúu"
 
  For i = 1 To Len(ReplacementList) Step 2
    Cells.Replace What:=Mid(ReplacementList, i, 1), Replacement:=Mid(ReplacementList, i + 1, 1), MatchCase:=True
  Next i
End Sub

One question.... if the ReplacementList gets really long later on, is there a way to display the code on more than one line? I don't think I'll ever get to that, but just in case.

This method is much more concise than others I've seen. All of them had two Constant arrays (?); one for accented characters and one for regular characters.

I can see where you are looking for the character and then replacing it with the following character in the list (i+1,1).
Out of curiosity, I assume it's the "Step 2" that tells the code not to replace A with É?
Thanks again Peter, you never cease to amaze me.
Best regards,

 

[Peter_SSs]

it replaced all with lowercase letters, but I was able to add MatchCase to resolve that.

I did wonder about MatchCase but since you did not have that in your post 1 code I figured that it must have been working for you without that.

Out of curiosity, I assume it's the "Step 2" that tells the code not to replace A with É?

Yes, the code replaces characters 1, 3, 5, etc with characters 2, 4, 6 etc

if the ReplacementList gets really long later on, is there a way to display the code on more than one line?

Two ways that you could do that.
1. With the code I provided above, you can split a long string like this

 Const ReplacementList As String = "áaée" _
                                  & "ÍIÓO"

2. Or you could move to 2 separate lists more like you were mentioning before. With the code below, there is no "step 2" as the code replaces every character in the first string with the corresponding character in the second string.

Sub RemoveAccents_v3()
  Dim i As Long
  
  Const SwapThis As String = "áéÍÓ"
  Const ForThis As String = "aeIO"
  
  For i = 1 To Len(SwapThis)
    Cells.Replace What:=Mid(SwapThis, i, 1), Replacement:=Mid(ForThis, i, 1), MatchCase:=True
  Next i
End Sub

 

[Alex Blakenburg]

Peter's version is more flexible if you want it to apply it to the entire worksheet since it will leave formulas intact but if you have a lot of data and there are no formulas using an array should be faster.
eg using Peter's option 2 above:
Note: substitute is case-sensitive.

Sub RemoveAccents_v3_Array()
  Dim i As Long
  Dim rng As Range, arr As Variant
 
  Const SwapThis As String = "áéÍÓ"
  Const ForThis As String = "aeIO"
 
  Set rng = ActiveSheet.UsedRange
  arr = rng.Value2
 
  For i = 1 To Len(SwapThis)
    arr = Application.Substitute(arr, Mid(SwapThis, i, 1), Mid(ForThis, i, 1))
  Next i
 
  rng.Value2 = arr
End Sub