phonetics

mole999

Well-known Member
Joined
Oct 23, 2004
Messages
10,524
Office Version
  1. 2019
  2. 2016
  3. 2013
Platform
  1. Windows
I'd like to in vba, read a cell and turn that content into its phonetic equivalent in another cell

i.e AFT - Alpha Foxtrot Tango

or 194 - One Niner Four

has anyone done this before (my search words didn't find any clues)

anything similar that i could start from, would be very helpful, i'm only looking to do about 10 letters maximum

closest comparable i can think of is numbers to words for cheques etc
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Interesting idea..

Build a lookup table that converts each character to it's phonetic couterpart.
In this UDF, I've used G1:H26

Code:
Function Phonetics(c As String)
Dim i As Long, MyChar As Variant, MyString As String
For i = 1 To Len(c)
    MyChar = Mid(c, i, 1)
    If IsNumeric(MyChar) Then MyChar = Val(MyChar)
    MyString = MyString & Application.VLookup(MyChar, Range("G1:H36"), 2, False) & " "
Next i
Phonetics = Trim(MyString)
End Function

Then use
=Phonetics(A1)
 
Upvote 0
Jonmo's solution is probably better then mine, but here is an alternate solution using VBA only.

Code:
Public Function StringToPhonetic(str As String)
Dim ltr as Long, s as String
For ltr = 1 To Len(str)
Select Case UCase(Mid(str, ltr, 1))
Case "A"
    s = s + "ALPHA "
Case "F"
    s = s + "FOXTROT "
Case "T"
    s = s + "TANGO "
Case "1"
    s = s + "ONE "
Case "4"
    s = s + "FOUR "
Case "9"
    s = s + "NINER "
Case Else
    s = s + Mid(str, ltr, 1) & " " 'unable to convert, place the original character in the output
End Select
Next ltr
StringToPhonetic = Trim(s) 'remove trailing space
End Function
 
Sub test()
    MsgBox StringToPhonetic("AFT")
End Sub

You can also use this as an UDF if you'd care to.
Also, you will obviously need to include ALL of the possibilities A-Z and 0-9.

The one advantage I can think of with this code over jonmo's is that if there is a unexpeted value such as punctuation, this will just put that punctution back into the output where as the Vlookup will return an error (I believe)
 
Upvote 0
Very much obliged to both of you, thank you for your time and thought
 
Upvote 0
Code:
Public Function StringToPhonetic(str As String)
'NATO Phonetic Alphabet

    Dim ltr As Long, s As String
           
    For ltr = 1 To Len(str)
        Select Case UCase(Mid(str, ltr, 1))
        Case "A"
            s = s + "ALPHA "
        Case "B"
            s = s + "BRAVO "
        Case "C"
            s = s + "CHARLIE "
        Case "D"
            s = s + "DELTA "
        Case "E"
            s = s + "ECHO "
        Case "F"
            s = s + "FOXTROT "
        Case "G"
            s = s + "GOLF "
        Case "H"
            s = s + "HOTEL "
        Case "I"
            s = s + "INDIA "
        Case "J"
            s = s + "JULIET "
        Case "K"
            s = s + "KILO "
        Case "L"
            s = s + "LIMA "
        Case "M"
            s = s + "MIKE "
        Case "N"
            s = s + "NOVEMBER "
        Case "O"
            s = s + "OSCAR "
        Case "P"
            s = s + "PAPA "
        Case "Q"
            s = s + "QUEBEC "
        Case "R"
            s = s + "ROMEO "
        Case "S"
            s = s + "SIERRA "
        Case "T"
            s = s + "TANGO "
        Case "U"
            s = s + "UNIFORM "
        Case "V"
            s = s + "VICTOR "
        Case "W"
            s = s + "WHISKEY "
        Case "X"
            s = s + "XRAY "
        Case "Y"
            s = s + "YANKEE "
        Case "Z"
            s = s + "ZULU "
        Case "1"
            s = s + "ONE "
        Case "2"
            s = s + "TWO "
        Case "3"
            s = s + "THREE "
        Case "4"
            s = s + "FOUR "
        Case "5"
            s = s + "FIVE "
        Case "6"
            s = s + "SIX "
        Case "7"
            s = s + "SEVEN "
        Case "8"
            s = s + "EIGHT "
        Case "9"
            s = s + "NINE "
        Case "0"
            s = s + "ZERO "
        Case Else
            s = s + Mid(str, ltr, 1) & " "    'unable to convert, place the original character in the output
        End Select
    Next ltr
    StringToPhonetic = Trim(s)    'remove trailing space
    
    ' other meanings / history
    'http://en.wikipedia.org/wiki/ICAO_spelling_alphabet
End Function

Sub test()
Dim x As String
x = Range("a1")
    Range("a2") = StringToPhonetic(x)
End Sub

by way of completeness, should anyone else need such a device
 
Upvote 0
This works,

Code:
Public Function phonetic2(str As String) As String
Dim l As Long, phstring As String, tmpstr As String, mchar As String
phstring = "Zero    One     Two     Three   Four    Five    Six     Seven   Eight   Niner   " & _
                "Alpha   Bravo   Charlie Delta   Echo    Foxtrot Golf    Hotel   India   Juliet  " & _
                "Kilo    Lima    Mike    NovemberOscar   Papa    Quebec  Romeo   Sierra  Tango   " & _
                "Uniform Victor  Whiskey X-Ray   Yankee  Zulu"
For l = 1 To Len(str)
        mchar = UCase(Mid(str, l, 1))
    Select Case mchar
        Case 0 To 9
            tmpstr = tmpstr & Trim(Mid(phstring, (Asc(mchar) - 48) * 8 + 1, 8)) & " "
        Case "A" To "Z"
            tmpstr = tmpstr & Trim(Mid(phstring, (Asc(mchar) - 55) * 8 + 1, 8)) & " "
        Case Else
            tmpstr = tmpstr & mchar
    End Select
Next
phonetic2 = Trim(tmpstr)
End Function

This doesn't work properly, I'm missing something simple, just not sure what, posting it to see if anyone can see why.

Code:
Public Function phonetic(str As String) As String
Dim l As Long, pharray, tmpstr As String, mchar As String
pharray = Array("Zero", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Niner", _
                "Alpha", "Bravo", "Charlie", "Delta", "Echo", "Foxtrot", "Golf", "Hotel", "India", "Juliet", _
                "Kilo", "Lima", "Mike", "November", "Oscar", "Papa", "Quebec", "Romeo", "Sierra", "Tango", _
                "Uniform", "Victor", "Whiskey", "X-Ray", "Yankee", "Zulu")
For l = 1 To Len(str)
        mchar = UCase(Mid(str, l, 1))
    Select Case mchar
        Case 0 To 9
            tmpstr = tmpstr & pharray(Asc(mchar) - 48) & " "
        Case "A" To "Z"
            tmpstr = tmpstr & pharray(Asc(mchar) - 55) & " "
        Case Else
            tmpstr = tmpstr & mchar
    End Select
Next
phonetic = Trim(tmpstr)
End Function

When the function is called in vba all is good.

Code:
Sub test()
MsgBox phonetic("AFT149")
End Sub

Returns the expected result.

However, when used in a worksheet formula it returns #N/A, I'm guessing you can't use a udf with a declared array in a worksheet :confused:
 
Upvote 0
I'm missing something simple, just not sure what, posting it to see if anyone can see why.

You're going to laugh (or cry)...

There is an actual Excel formula with the name PHONETIC.

Change your UDF name to MyPhonetic and it will work fine as an UDF.

:laugh:
 
Upvote 0

Forum statistics

Threads
1,223,098
Messages
6,170,100
Members
452,301
Latest member
QualityAssurance

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top