phonetics

[mole999]

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

 

[Jonmo1]

Interesting idea..

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

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)

 

[BiocideJ]

Jonmo's solution is probably better then mine, but here is an alternate solution using VBA only.

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)

 

[mole999]

Very much obliged to both of you, thank you for your time and thought

 

[mole999]

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

 

[jasonb75]

This works,

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.

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.

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

 

[BiocideJ]

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.

 

[jasonb75]

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

Both, and curse MS for another hidden function that appears to be absolutely useless lol.