Remembering Telephone Numbers

Can’t remember your telephone number? Here’s a macro that will tell you all the words that the last four digits of a telephone number spell.

I don’t know who wrote this. I may have done it, there were tell-tale signs of my poor coding practices when I found this. But if it wasn’t me, then apologies to whomever the author is. If it was you, let me know and I’ll give you proper credit.

It’s not perfect. Zeros really screw it up. There’s got to be a better way to do this, but I’m so whacked out on caffeine and nicotine that reading this code makes my hair hurt. So I’ll leave it up to you to come up with a better way.

`Sub FindTeleWords()`

``` Dim ChkSt As String Dim NewSt As String Dim CurrLet As String Dim i As Long, j As Long Dim k As Long, l As Long Dim m As Long, n As Long Dim AddOne As Long Dim sMsg As String 'Get the Number ChkSt = InputBox("Enter the last four digits of a telephone number") If Len(ChkSt) <> 4 Then Exit Sub End If sMsg = "Words for " & ChkSt & " are:" & vbNewLine & vbNewLine 'Three letters per number and 4 numbers For i = 1 To 3: For j = 1 To 3: For k = 1 To 3: For l = 1 To 3 'Loop through the 4 numbers For m = 1 To 4 'n gets us to the right letter depending on 'where we are in the 1 to 3 loop Select Case m Case 1 n = i Case 2 n = j Case 3 n = k Case 4 n = l End Select CurrLet = Mid(ChkSt, m, 1) 'Account for Q in the 7 If CurrLet = "8? Or CurrLet = "9? Then AddOne = 1 ElseIf CurrLet = "7? And n >= 2 Then AddOne = 1 Else AddOne = 0 End If 'Build the potential word NewSt = NewSt & Chr\$((64 + (CInt(CurrLet) - 2) * 3) + AddOne + n) Next m 'Write the word if itÓł in the dictionary If Application.CheckSpelling(NewSt) Then sMsg = sMsg & NewSt & vbNewLine End If 'Reinitialize the word for the next go NewSt = "" Next l: Next k: Next j: Next i MsgBox sMsg ```

`End Sub`

2 thoughts on “Remembering Telephone Numbers”

1. Mike Woodhouse says:

Uurrrgh. I hates big nested loops, I hates ’em. This looked like it was screaming for recursion, so I tried it (below). The code’s not as expressive as I would ideally like, but it’ll do for now.

Option Explicit

Private words As Collection
Private letters As Variant
Private numbers As Variant
Private lettersNeeded As Long

Public Sub WordsFromPhoneNumber(inputNumber As String)

Dim index As Long
Dim word As Variant

‘ from 0 to 9 on my Nokia mobile:
letters = Array(“0?, “1?, “abc”, “def”, “ghi”, “jkl”, “mno”, “pqrs”, “tuv”, “wxyz”)

ReDim numbers(1 To Len(inputNumber))

lettersNeeded = Len(inputNumber)

For index = 1 To lettersNeeded
numbers(index) = CInt(Mid(inputNumber, index, 1))
Next

Set words = New Collection

BuildWords “”, 1

For Each word In words
Debug.Print word
Next

End Sub

Private Sub BuildWords(wordSoFar, numberIndex)

Dim letterIndex As Long
Dim nextLetter As String
Dim nextWord As String

For letterIndex = 1 To Len(letters(numbers(numberIndex)))

nextLetter = Mid(letters(numbers(numberIndex)), letterIndex, 1)
nextWord = wordSoFar & nextLetter

If numberIndex < lettersNeeded Then
BuildWords nextWord, numberIndex + 1
Else