Hello, I have a cyrillic transliteration macro for excel that I would like to adapt for Word 2013. In excel, the macro operates on any characters in selected cells. In word, I would like it to operate on selected text, but I don't know how to code that.

The excel macro code is shown below.

Thanks in advance.

Russ

Sub Selection_Transliterate_Cyrillic()
'PURPOSE: Find & Transliterate Cyrillic Characters


    Dim Rng As Range
    Dim FndList As Variant
    Dim rplcList As Variant
    Dim X As Long


    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual


FndList = Array(ChrW(&H410), ChrW(&H411), ChrW(&H412), ChrW(&H413), ChrW(&H414), ChrW(&H415), ChrW(&H401), ChrW(&H416), ChrW(&H417), ChrW(&H418), ChrW(&H419), ChrW(&H41A), ChrW(&H41B), ChrW(&H41C), ChrW(&H41D), ChrW(&H41E), ChrW(&H41F), ChrW(&H420), ChrW(&H421), ChrW(&H422), ChrW(&H423), ChrW(&H424), ChrW(&H425), ChrW(&H426), ChrW(&H427), ChrW(&H428), ChrW(&H429), ChrW(&H42A), ChrW(&H42B), ChrW(&H42C), ChrW(&H42D), ChrW(&H42E), ChrW(&H42F), ChrW(&H406), ChrW(&H472), ChrW(&H462), ChrW(&H474), ChrW(&H430), ChrW(&H431), ChrW(&H432), ChrW(&H433), ChrW(&H434), ChrW(&H435), ChrW(&H451), ChrW(&H436), ChrW(&H437), ChrW(&H438), ChrW(&H439), ChrW(&H43A), ChrW(&H43B), ChrW(&H43C), ChrW(&H43D), ChrW(&H43E), ChrW(&H43F), ChrW(&H440), ChrW(&H441), ChrW(&H442), ChrW(&H443), ChrW(&H444), ChrW(&H445), ChrW(&H446), ChrW(&H447), ChrW(&H448), ChrW(&H449), ChrW(&H44A), ChrW(&H44B), ChrW(&H44C), ChrW(&H44D), ChrW(&H44E), ChrW(&H44F), ChrW(&H456), ChrW(&H473), ChrW(&H463), ChrW(&H475))


rplcList = Array("A", "B", "V", "G", "D", "E", "Yo", "Zh", "Z", "I", "Y", "K", "L", "M", "N", "O", "P", "R", "S", "T", "U", "F", "Kh", "Ts", "Ch", "Sh", "Shch", "", "Y", "", "E", "Yu", "Ya", "I", "F", "E", "I", "a", "b", "v", "g", "d", "e", "yo", "zh", "z", "i", "y", "k", "l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "kh", "ts", "ch", "sh", "shch", "", "y", "", "e", "yu", "ya", "i", "f", "e", "i")




    With ActiveWorkbook.ActiveSheet
        Set Rng = Intersect(ActiveSheet.UsedRange, Selection)
            'Loop through each item in Array lists
             For X = LBound(FndList) To UBound(FndList)
                  Rng.Cells.Replace what:=FndList(X), replacement:=rplcList(X), _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, _
          SearchFormat:=False, ReplaceFormat:=False
              Next X
        
    End With


    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
End Sub