Excel VBA Keyword Accent Variation

Question

I was needing a code that could provide me variations for words with accents. I'm from Brazil and our vocabulary as you know, is full of those.

Let's say I type "cartão de crédito" (which is credit card) and "avião" (airplane) from C8 onward, and now, beginning from G8, I need to sheet to give all the possible variations for the accents of these words, which would give me the following:

cartão de crédito cartão de credito cartao de crédito cartao de credito avião aviao

I did came up with something I put together after a long research. Since I'm not and expert, there are some parts of the code that I do not know exactly how it works.

The problem is that my code works on Windows very fine, but on Excel for MAC, the code runs, but does not give me the variations, it only repeats what I inserted on column C.

I was hoping to have an alternate code so that I could compare to mine and see what I could have done wrong. Can you help me?

Here's my code (remember, it WORKS on Windows)

Dim A(0 To 100, 0 To 1) As String
Dim Part(0 To 20, 0 To 1) As String
Dim lastpart As Integer
Dim MaxA As Integer
Dim CurRow As Integer
Dim cell As Range
Dim rgColuna1 As String
Dim rgColunafinal As String

Sub VariarAcentos()

' Define as variaveis
coluna1 = "C8"
colunaFinal = "G8"
rgColuna1 = "C8:C1048576"
rgColunafinal = "G8:G1048576"

Application.ScreenUpdating = False

' Verifica se o gerador esta vazio
If Range(coluna1) = "" Then
MsgBox "A planilha está vazia." & vbNewLine & "Preencha a primeira coluna.", vbInformation, "Planilha vazia"

Else

' Seleciona coluna "G" a partir da linha 8 e limpa todo o conteudo
Range(rgColunafinal).Select
Selection.ClearContents

' Define regra para variacoes
A(0, 0) = Chr(227) ' ã
A(1, 0) = Chr(225) ' á
A(2, 0) = Chr(224) ' à
A(3, 0) = Chr(226) ' â
A(4, 0) = Chr(228) ' ä
A(5, 0) = Chr(231) ' ç
A(6, 0) = Chr(233) ' é
A(7, 0) = Chr(232) ' è
A(8, 0) = Chr(234) ' ê
A(9, 0) = Chr(235) ' ë
A(10, 0) = Chr(237) ' í
A(11, 0) = Chr(236) ' ì
A(12, 0) = Chr(238) ' î
A(13, 0) = Chr(239) ' ï
A(14, 0) = Chr(241) ' ñ
A(15, 0) = Chr(243) ' ó
A(16, 0) = Chr(242) ' ò
A(17, 0) = Chr(244) ' ô
A(18, 0) = Chr(245) ' õ
A(19, 0) = Chr(246) ' ö
A(20, 0) = Chr(250) ' ú
A(21, 0) = Chr(249) ' ù
A(22, 0) = Chr(251) ' û
A(23, 0) = Chr(252) ' ü
A(24, 0) = Chr(253) ' ý
A(25, 0) = Chr(255) ' ÿ

A(0, 1) = "a"
A(1, 1) = "a"
A(2, 1) = "a"
A(3, 1) = "a"
A(4, 1) = "a"
A(5, 1) = "c"
A(6, 1) = "e"
A(7, 1) = "e"
A(8, 1) = "e"
A(9, 1) = "e"
A(10, 1) = "i"
A(11, 1) = "i"
A(12, 1) = "i"
A(13, 1) = "i"
A(14, 1) = "n"
A(15, 1) = "o"
A(16, 1) = "o"
A(17, 1) = "o"
A(18, 1) = "o"
A(19, 1) = "o"
A(20, 1) = "u"
A(21, 1) = "u"
A(22, 1) = "u"
A(23, 1) = "u"
A(24, 1) = "y"
A(25, 1) = "y"

MaxA = 26
CurRow = 8

' Transforma valores em minusculas
If Range(coluna1) <> "" And Range("C9") = "" Then
Range(coluna1).Select
Else
Range(coluna1).Select
Range(Selection, Selection.End(xlDown)).Select
End If

Transforma:
For Each cell In Selection.Cells
If cell.HasFormula = False Then
cell = LCase(cell)
End If
Next

' Comeca checagem para variacao
Checagem:
For Each p In Range(rgColuna1)
    If p.Value = "" Then
        Exit For
    End If

    For i = 0 To 20
        Part(i, 0) = ""
        Part(i, 1) = ""
    Next i

    lasti = 1
    lastpart = 0
    For i = 1 To Len(p)
        Letra = Mid(p, i, 1)
        For j = 0 To MaxA
            If Letra = A(j, 0) Then
                lastpart = lastpart + 1
                Part(lastpart, 0) = Mid(p, lasti, i - lasti + 1)
                Part(lastpart, 1) = Mid(p, lasti, i - lasti) & A(j, 1)
                lasti = i + 1
            End If
        Next j
    Next i
    lastpart = lastpart + 1
    Part(lastpart, 0) = Mid(p, lasti, i - lasti + 1)
    Part(lastpart, 1) = Mid(p, lasti, i - lasti + 1)

    ReplaceAcc "", 1

Next p

' Seleciona e copia o conteudo final
Range(colunaFinal).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Range("A1").Select

Application.ScreenUpdating = True

End If

End Sub
Private Function ReplaceAcc(Before, pIndex) As String
    ' Define o posicionamento da coluna final: Linha 8 da coluna 7
    If pIndex = lastpart Then
        ActiveSheet.Cells(CurRow, 7).Value = Before & Part(pIndex, 0)
        CurRow = CurRow + 1
    Else
        ReplaceAcc Before & Part(pIndex, 0), pIndex + 1
        ReplaceAcc Before & Part(pIndex, 1), pIndex + 1
    End If

End Function

I'd suggest having Code Review clean up your WORKING Windows code and then port that over to Mac to see if cleaning up the code will help. There are many things that could be easily cleaned up like [not using Select](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) or defining a Range object variable instead of passing ranges through strings and using Range(string). — Chrismas007, Mar 06 '15 at 18:16
Hey Chrismas, thanks for pointing the direction. The problem I've is a knowledge range right now :/ I did clean up the code from what I know and what I could, but for everything else, it's a bit hard. I'll take a look on the "not using select" . I've used Range(string) as a way to change the cell one time through the variable, will take a lookt of that to — SoMeGoD, Mar 06 '15 at 18:30
Got it to work. Te problem was in the Chr() codes that are not the same from one system to another. I don't know if this is from Excel Win to Excel OSX or just language settings. ã is Chr(227) on Excel for Windows PT-BR, and Chr(139) for Excel OSX in English. Hope this helps someone who is messing with Chr() — SoMeGoD, Mar 06 '15 at 23:11

score 0 · Answer 1 · answered Mar 06 '15 at 23:13

Got it to work. Te problem was in the Chr() codes that are not the same from one system to another. I don't know if this is from Excel Win to Excel OSX or just language settings. For instance: "ã" is Chr(227) on Excel for Windows PT-BR, and Chr(139) for Excel OSX in English. Hope this helps someone who is messing with Chr(). Took me a good ammount of time to figure this.

Excel VBA Keyword Accent Variation

1 Answers1