Create script to generate report from spreadsheet for word game RRS feed

  • 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:
    Average word value per grade
    Median word value per grade 
    Shortest word per grade
    Longest word per grade
    Highest word value 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.




    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
    Dic.Add Sheets("SHEET1").Cells(i, 1).Value,Sheets("SHEET1").Cells(i, 2).Value
    Next i
    End If
    End Sub
    Function CalWordValue(rng As Range)
    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()
    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
    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,


    Thursday, July 6, 2017 8:27 AM