# Create script to generate report from spreadsheet for word game

• ### Question

• Hi Developers,

1: Create a script that gives a numerical value for all the words in the word list based on the alphabet value. For example, if C = 30, A = 10, R = 10. Then the word value for CAR is 50.

2: Once task 1 is complete, generate the following information per grade:

I have attached a screendump with the alphabet and corresponding value. In addition, I have attached the word list screen dump with grade levels.

﻿﻿

Thanks,

Senthil

Sunday, June 25, 2017 7:19 PM

• Hi Senthil,

You could use Scripting.Dictionary to save the Corresponding Relation between the letter and the value. And then you could use it to calculate the value of the word in a cell. Here is the example.

'need add reference Microsoft Scripting Runtime

Public Dic As Scripting.Dictionary

Sub InitDic()
If Dic Is Nothing Then
Set Dic = New Scripting.Dictionary
For i = 2 To 27
Next i
End If
End Sub

Function CalWordValue(rng As Range)
InitDic
Dim str As String
str = UCase(rng.Value)
For i = 1 To Len(str)
CalWordValue = CalWordValue + Dic.Item(Mid(str, i, 1))
Next i
End Function

I suggest you add value of words into array and length of these words into another array. Then we could get it's max value, median value, shortest word... Here is the example

Sub TEST()
InitDic
Dim sht As Worksheet
Set sht = ActiveSheet
Dim lastrow As Integer
RowCount = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row

Dim valueArr() As Integer
Dim lenArr() As Integer
ReDim valueArr(1 To RowCount)
ReDim lenArr(1 To RowCount)

For i = 1 To RowCount
valueArr(i) = CalWordValue(sht.Cells(i, 1))
lenArr(i) = Len(sht.Cells(i, 1))
Next i

'sort the array for getting median value
For i = 1 To UBound(valueArr)
For j = i + 1 To UBound(valueArr)
If valueArr(i) > valueArr(j) Then
TEMP = valueArr(j)
valueArr(j) = valueArr(i)
valueArr(i) = TEMP
End If
Next j
Next i

maxValue = valueArr(RowCount)
avaValue = Round(WorksheetFunction.Average(valueArr), 2)
If RowCount Mod 2 = 0 Then
medValue = (valueArr(RowCount / 2) + valueArr(RowCount / 2 + 1)) / 2
Else
medValue = valueArr((RowCount + 1) / 2)
End If

maxIdx = 1
minIdx = 1
maxLen = 0
minLen = 999
For i = 1 To UBound(lenArr)
If lenArr(i) > maxLen Then
maxIdx = i
maxLen = lenArr(i)
End If

If lenArr(i) < minLen Then
minIdx = i
minLen = lenArr(i)
End If
Next i

Debug.Print "Average value is " & avaValue
Debug.Print "Median  value is " & medValue
Debug.Print "Highest value is " & maxValue
Debug.Print "Shortest word is " & sht.Cells(minIdx, 1)
Debug.Print "Longest word is " & sht.Cells(maxIdx, 1)
End Sub

Best Regards,

Terry

Thursday, July 6, 2017 8:27 AM