# Euler Problem 22

Euler Problem 22 asks:

‘Using names.txt (right click and ‘Save Link/Target As…’), a 46K text file containing over
‘five-thousand first names, begin by sorting it into alphabetical order. Then working out the
‘alphabetical value for each name, multiply this value by its alphabetical position in the list
‘to obtain a name score.

‘For example, when the list is sorted into alphabetical order, COLIN, which is worth
‘3 + 15 + 12 + 9 + 14 = 53, is the 938th name in the list. So, COLIN would obtain a score of
‘938 * 53 = 49714.

‘What is the total of all the name scores in the file?

The general task is to time the calculation.
The specific tasks are:

1. Open the file
2. Clean it up (it’s one long line of data, with names wrapped in quotes, and comma-delimited, as in …,”COLIN”,…)
3. Sort the names
4. Determine each name’s alphabetical value
5. Multiply the position by the value
6. Sum the scores

Here is my code:

Option Explicit
Sub Problem_022()
Dim NameArray As Variant
Dim TEMP    As String
Dim T       As Single
Dim i       As Long
Dim j       As Long
Dim Score   As Long
Dim Answer  As Long
ames.txt”

T = Timer ‘start timing
Open namestext For Input As #1 ‘ open the file
Do While Not EOF(1)
Line Input #1, TEMP
Loop
Close #1
TEMP = VBA.Replace(TEMP, Chr(34), vbNullString) ‘strip quotes — chr(34)

NameArray = Split(TEMP, “,”)   ‘TEMP a comma delimited file, split on the comma
‘creating an array to sort
‘BubbleSort
For i = LBound(NameArray) To UBound(NameArray) – 1
For j = i To UBound(NameArray)
If NameArray(i) &gt; NameArray(j) Then
TEMP = NameArray(j)
NameArray(j) = NameArray(i)
NameArray(i) = TEMP
End If
Next j
Next i

For i = LBound(NameArray) To UBound(NameArray)
Score = LexValue(CStr(NameArray(i))) ‘computes the alphabetic value
Answer = Answer + (Score * (i + 1))   ‘ NameArray is zero-based
‘multiplies and sums
Score = 0
Next i

Debug.Print Answer; ”  Time:”; Timer – T

End Sub

NameArray is zero-based. Euler’s names aren’t. The first name has position 1. We need to offset by 1.
The alphabetic value is just the sum of the ascii codes (offset by 64, so “A” gets 1) for each letter. This little function does that. It’ll be used in other Euler problems.

Function LexValue(Word As String) As Long
Dim i       As Long
For i = 1 To Len(Word)
LexValue = LexValue + (Asc(Mid(Word, i, 1)) – 64)
Next i
End Function

This runs in 15 seconds
…mrt

Posted in Uncategorized

## 4 thoughts on “Euler Problem 22”

1. dbb says:

This is also one of the few Euler problems you can do entirely in a worksheet

2. Hans Schraven says:

This runs in less than a second

Sub euler22()
Dim c0 As String, c1 As Long, c2 As Long, t As Single

t = Timer
c0 = “ACDEFGHIJKLMNOPQRSTUVWXYZ”
ames.txt”

With ActiveWorkbook.Sheets(1)
sq = Split(Replace(Join(Split(.Range(“A1”), “”“,”“”), “|”), “,” &amp; Chr(34), “|”), “|”)
.Range(“A1”).Resize(UBound(sq)) = Application.WorksheetFunction.Transpose(sq)
With .Columns(1)
.Sort [A1]
sq = .SpecialCells(xlCellTypeConstants)
End With
End With
For j = 1 To UBound(sq)
c1 = 0
For jj = 1 To Len(sq(j, 1))
c1 = c1 + InStr(c0, Mid(sq(j, 1), jj, 1))
Next
c2 = c2 + c1 * j
Next
t = Timer – t
Debug.Print “total “ &amp; c2 &amp; ” time “ &amp; t
End Sub
3. Hans Schraven says:

Some improvements:

Sub euler22()
Dim c1 As Single, c2 As Long, T As Long, j As Integer, jj As Integer, Rng As Range
Const c0 = “ACDEFGHIJKLMNOPQRSTUVWXYZ”

T = Timer
ames.txt”
For Input As #1
sq = Split(Mid(Input(LOF(1) – 1, #1), 2), “”“,”“”)
Close #1

Set Rng = ActiveWorkbook.Sheets(1).Cells(1, 1).Resize(UBound(sq) + 1)
Rng = Application.WorksheetFunction.Transpose(sq)
Rng.Sort [A1]
sq = Rng

For j = 1 To UBound(sq)
c1 = 0
For jj = 1 To Len(sq(j, 1))
c1 = c1 + InStr(c0, Mid(sq(j, 1), jj, 1))
Next
c2 = c2 + (c1 * j)
Next

Debug.Print “total: “ &amp; c2 &amp; ” time: “ &amp; Timer – T
End Sub

Posting code? Use <pre> tags for VBA and <code> tags for inline.