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 caffiene 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’s 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
Mike Woodhouse:
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
words.Add nextWord
End If
Next
End Sub
14 May 2004, 5:25 amDick:
Mike: I agree about big nested loops. When I know the number of loops (4 in this case), I’m too lazy to use recursion. I like what you’ve done though, you just need to add a CheckSpelling line.
14 May 2004, 8:15 am