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?

‘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:

- Open the file
- Clean it up (it’s one long line of data, with names wrapped in quotes, and comma-delimited, as in …,”COLIN”,…)
- Sort the names
- Determine each name’s alphabetical value
- Multiply the position by the value
- 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

Const namestext As String = “D:DownloadsEuler

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) > 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

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

Const namestext As String = “D:DownloadsEuler

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) > 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

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

For a code-less solution see http://www.tushar-mehta.com/misc_tutorials/project_euler/euler022.html

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

This runs in less than a second

Dim c0 As String, c1 As Long, c2 As Long, t As Single

t = Timer

c0 = “ACDEFGHIJKLMNOPQRSTUVWXYZ”

Workbooks.Open “E:download

ames.txt”

With ActiveWorkbook.Sheets(1)

sq = Split(Replace(Join(Split(.Range(“A1”), “”“,”“”), “|”), “,” & 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 “ & c2 & ” time “ & t

End Sub

Some improvements:

Dim c1 As Single, c2 As Long, T As Long, j As Integer, jj As Integer, Rng As Range

Const c0 = “ACDEFGHIJKLMNOPQRSTUVWXYZ”

T = Timer

Open “E:download

ames.txt” For Input As #1

sq = Split(Mid(Input(LOF(1) – 1, #1), 2), “”“,”“”)

Close #1

Workbooks.Add

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: “ & c2 & ” time: “ & Timer – T

End Sub