Sum of the alphabet's assigned values till 2 digits in single cell

Velks

New Member
Joined
Apr 22, 2017
Messages
27
Hi Experts,

I want to Sum the alphabet's assigned values till 2 digits, where each alphabets are assigned with value which can be changed as and when needed.

Below example might give more clarity on my question. Sorry for my poor language.

I'm having the word "ABCDE" in cell "A2" and I want the Result as "21" in "B2".

Assigned Values are...

A=1 B=2, C=3, D=4, E=5, etc.,

Calculation:

ABCDE
1+2+3+4+5
3+5+7+9
8+3+7
2+1. 21 is the expected result.

BCD
234
57

for ABC 57 is the Result and for DCB 75.

DCB
432
75

Note:
All the double digits are converted in to single digits like 12 as 3, 16 as 7 and so on by MOD 9.

I'm ready to use ASCII codes to assign the dynamic values for alphbats.
Thanks in advance.
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Please help to skip the calculation for wherever 0 comes.

For Example, "A B" , i want like 1 2 = => 12 or 1 0 2 ==> 12
Question... does the above mean whenever any character whose value is 0 is in the text, that character should be ignored in the same way you are describing the space character, when its value is 0, should be ignored?

I have written a UDF for you to calculate the sum of the values for each letter. This UDF allows you to add more Value Sets and to specify which Value Set to use when you call the function. I have called this UDF "LetterSum" since that is exactly what the function does. Here is the code...
Code:
[table="width: 500"]
[tr]
	[td]Function LetterSum(Word As String, ValueSet As Long) As Long
  Dim X As Long, VSet As Variant, ValSet() As String, Arr() As String
  
[B][COLOR="#008000"]  ' This section controls your Value Sets. When you add additional
  ' Value Sets, change the number after the "To" (2 at the start) to
  ' the maximum Value Set number. So, if you add two more Value Sets
  ' (3 and 4 inside the parentheses after the ValSet name), then the
  ' number that follows word "To" would be changed to 4.[/COLOR][/B]
  ReDim ValSet(1 To 2)
  ValSet(1) = "0,0,0,0,0,0,10,0,0,0,13,14,0,0,0,9,0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,3,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8 ,0,0,0,0,0,3,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,0,0,0,0"
  ValSet(2) = "0,0,0,0,0,0,10,0,0,0,10,20,0,0,0,3,0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,5,1,2,3,4,5,8,3,5,1,1,2,3,4,5,7,8,1,2,3,4,6,6,6,5,1,7 ,0,0,0,0,0,5,1,2,3,4,5,8,3,5,1,1,2,3,4,5,7,8,1,2,3,4,6,6,6,5,1,7,0,0,0,0"
  
  VSet = Split(String(32, ",") & ValSet(ValueSet), ",")
  For X = 1 To Len(Word)
    LetterSum = LetterSum + VSet(Asc(Mid(Word, X, 1)))
  Next
End Function[/td]
[/tr]
[/table]
The first argument is the word whose letters you want to count and the second argument is the Value Set whose values you want to use to sum that word's letters. So, to get the letter sum of a word in cell A2, using the first Value Set, you would call it this way...

=LetterSum(A2,1)
 
Last edited:
Upvote 0
Question... does the above mean whenever any character whose value is 0 is in the text, that character should be ignored in the same way you are describing the space character, when its value is 0, should be ignored?

I have written a UDF for you to calculate the sum of the values for each letter. This UDF allows you to add more Value Sets and to specify which Value Set to use when you call the function. I have called this UDF "LetterSum" since that is exactly what the function does. Here is the code...
Code:
[TABLE="width: 500"]
<tbody>[TR]
[TD]Function LetterSum(Word As String, ValueSet As Long) As Long
  Dim X As Long, VSet As Variant, ValSet() As String, Arr() As String
  
[B][COLOR=#008000]  ' This section controls your Value Sets. When you add additional
  ' Value Sets, change the number after the "To" (2 at the start) to
  ' the maximum Value Set number. So, if you add two more Value Sets
  ' (3 and 4 inside the parentheses after the ValSet name), then the
  ' number that follows word "To" would be changed to 4.[/COLOR][/B]
  ReDim ValSet(1 To 2)
  ValSet(1) = "0,0,0,0,0,0,10,0,0,0,13,14,0,0,0,9,0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,3,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8 ,0,0,0,0,0,3,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,0,0,0,0"
  ValSet(2) = "0,0,0,0,0,0,10,0,0,0,10,20,0,0,0,3,0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,5,1,2,3,4,5,8,3,5,1,1,2,3,4,5,7,8,1,2,3,4,6,6,6,5,1,7 ,0,0,0,0,0,5,1,2,3,4,5,8,3,5,1,1,2,3,4,5,7,8,1,2,3,4,6,6,6,5,1,7,0,0,0,0"
  
  VSet = Split(String(32, ",") & ValSet(ValueSet), ",")
  For X = 1 To Len(Word)
    LetterSum = LetterSum + VSet(Asc(Mid(Word, X, 1)))
  Next
End Function[/TD]
[/TR]
</tbody>[/TABLE]
The first argument is the word whose letters you want to count and the second argument is the Value Set whose values you want to use to sum that word's letters. So, to get the letter sum of a word in cell A2, using the first Value Set, you would call it this way...

=LetterSum(A2,1)


Thanks a lot, it works perfectly. :)

//Question... does the above mean whenever any character whose value is 0 is in the text, that character should be ignored in the same way you are describing the space character, when its value is 0, should be ignored?// Yes. This is required for WordSum code but it is not mandatory for LetterSum code as there is no changes in results even if we sum 0.
 
Upvote 0
Question... does the above mean whenever any character whose value is 0 is in the text, that character should be ignored in the same way you are describing the space character, when its value is 0, should be ignored?// Yes. This is required for WordSum code...
Updated to ignore all characters whose assigned value is 0:
Code:
Option Base 1
Function WordSum(InpStr As String, Optional SetNo As Byte = 1) As Byte
    SymArr = Array(32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126)
    ValArr1 = Array(0, 0, 0, 0, 0, 0, 10, 0, 0, 0, 13, 14, 0, 0, 0, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 0, 0, 0, 0, 0, 3, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 0, 0, 0, 0, 0, 3, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 0, 0, 0, 0)
    ValArr2 = Array(0, 0, 0, 0, 0, 0, 10, 0, 0, 0, 10, 20, 0, 0, 0, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 0, 0, 0, 0, 0, 5, 1, 2, 3, 4, 5, 8, 3, 5, 1, 1, 2, 3, 4, 5, 7, 8, 1, 2, 3, 4, 6, 6, 6, 5, 1, 7, 0, 0, 0, 0, 0, 5, 1, 2, 3, 4, 5, 8, 3, 5, 1, 1, 2, 3, 4, 5, 7, 8, 1, 2, 3, 4, 6, 6, 6, 5, 1, 7, 0, 0, 0, 0)
    ValArr = Array(ValArr1, ValArr2)
    n = Len(InpStr)
    If n = 0 Then Exit Function
    ReDim TmpArr(1 To n)
    j = 0
    For i = 1 To n
        TmpArr(i) = ValArr(SetNo)(Application.Match(Asc(Mid(InpStr, i, 1)), SymArr, 0))
        If TmpArr(i) > 0 Then j = j + 1: TmpArr(j) = TmpArr(i)
    Next i
    n = j
    Select Case n
        Case 0: Exit Function
        Case 1: WordSum = TmpArr(1): Exit Function
        Case 2
            For i = 1 To 2
                TmpArr(i) = TmpArr(i) \ 10 + TmpArr(i) Mod 10
            Next i
        Case Else
            Do
            n = n - 1
            For i = 1 To n
                TmpArr(i) = ((TmpArr(i) + TmpArr(i + 1) - 1) Mod 9) + 1
            Next i
            Loop Until n = 2
    End Select
    WordSum = TmpArr(1) * 10 + TmpArr(2)
End Function
 
Upvote 0
//Question... does the above mean whenever any character whose value is 0 is in the text, that character should be ignored in the same way you are describing the space character, when its value is 0, should be ignored?// Yes. This is required for WordSum code but it is not mandatory for LetterSum code as there is no changes in results even if we sum 0.
Here is my original UDF modified to let you add additional Value Sets (same as for the LetterSum function) and select the Value Set to use...
Code:
[table="width: 500"]
[tr]
	[td]Function WordSum(Word As String, ValueSet As Long) As Variant
  Dim X As Long, Arr As Variant, ValSet() As String, VSet() As String
  
[B][COLOR="#008000"]  ' This section controls your Value Sets. When you add additional
  ' Value Sets, change the number after the "To" (2 at the start) to
  ' the maximum Value Set number. So, if you add two more Value Sets
  ' (3 and 4 inside the parentheses after the ValSet name), then the
  ' number that follows word "To" would be changed to 4.[/COLOR][/B]
  ReDim ValSet(1 To 2)
  ValSet(1) = "0,0,0,0,0,0,10,0,0,0,13,14,0,0,0,9,0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,3,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8 ,0,0,0,0,0,3,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,0,0,0,0"
  ValSet(2) = "0,0,0,0,0,0,10,0,0,0,10,20,0,0,0,3,0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,5,1,2,3,4,5,8,3,5,1,1,2,3,4,5,7,8,1,2,3,4,6,6,6,5,1,7 ,0,0,0,0,0,5,1,2,3,4,5,8,3,5,1,1,2,3,4,5,7,8,1,2,3,4,6,6,6,5,1,7,0,0,0,0"
  
  VSet = Split(ValSet(ValueSet), ",")
  If Len(Word) > 1 Then
    Arr = Split(Application.Trim(Replace(" " & Application.Trim(Replace(StrConv(Word, vbUnicode), Chr(0), " ")), " 0 ", " ")))
    For X = 0 To UBound(Arr)
      Arr(X) = VSet(Asc(Arr(X)))
    Next
    Do Until Join(Arr) Like "# #"
      For X = 0 To UBound(Arr) - 1
        Arr(X) = ((Arr(X) + Arr(X + 1) - 1) Mod 9) + 1
      Next
      ReDim Preserve Arr(UBound(Arr) - 1)
    Loop
    WordSum = Arr(0) & Arr(1)
  Else
    WordSum = ""
  End If
End Function

Function LetterSum(Word As String, ValueSet As Long) As Long
  Dim X As Long, VSet As Variant, ValSet() As String, Arr() As String
  
  ' This section controls your Value Sets. When you add additional
  ' Value Sets, change the number after the "To" (2 at the start) to
  ' the maximum Value Set number. So, if you add two more Value Sets
  ' (3 and 4 inside the parentheses after the ValSet name), then the
  ' number that follows word "To" would be changed to 4.
  ReDim ValSet(1 To 2)
  ValSet(1) = "0,0,0,0,0,0,10,0,0,0,13,14,0,0,0,9,0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,3,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8 ,0,0,0,0,0,3,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,0,0,0,0"
  ValSet(2) = "0,0,0,0,0,0,10,0,0,0,10,20,0,0,0,3,0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,5,1,2,3,4,5,8,3,5,1,1,2,3,4,5,7,8,1,2,3,4,6,6,6,5,1,7 ,0,0,0,0,0,5,1,2,3,4,5,8,3,5,1,1,2,3,4,5,7,8,1,2,3,4,6,6,6,5,1,7,0,0,0,0"
  
  VSet = Split(String(32, ",") & ValSet(ValueSet), ",")
  For X = 1 To Len(Word)
    LetterSum = LetterSum + VSet(Asc(Mid(Word, X, 1)))
  Next
End Function[/td]
[/tr]
[/table]
 
Last edited:
Upvote 0
Note 2
==================
Unlike Tetra201's function, the module you put my WordSum function in should NOT be using Option Base 1.
I just made a minor change to my code and now it does not matter whether you use Option Base 0 or Option Base 1 any more. Here is that revised code (and I left out the LetterSum function this time, so feel free to copy the entire code window)...
Code:
[table="width: 500"]
[tr]
	[td]Function WordSum(Word As String, ValueSet As Long) As Variant
  Dim X As Long, Arr As Variant, ValSet() As String, VSet() As String
  
[B][COLOR="#008000"]  ' This section controls your Value Sets. When you add additional
  ' Value Sets, change the number after the "To" (2 at the start) to
  ' the maximum Value Set number. So, if you add two more Value Sets
  ' (3 and 4 inside the parentheses after the ValSet name), then the
  ' number that follows word "To" would be changed to 4.[/COLOR][/B]
  ReDim ValSet(1 To 2)
  ValSet(1) = "0,0,0,0,0,0,10,0,0,0,13,14,0,0,0,9,0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,3,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8 ,0,0,0,0,0,3,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,0,0,0,0"
  ValSet(2) = "0,0,0,0,0,0,10,0,0,0,10,20,0,0,0,3,0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,5,1,2,3,4,5,8,3,5,1,1,2,3,4,5,7,8,1,2,3,4,6,6,6,5,1,7 ,0,0,0,0,0,5,1,2,3,4,5,8,3,5,1,1,2,3,4,5,7,8,1,2,3,4,6,6,6,5,1,7,0,0,0,0"
  
  VSet = Split(ValSet(ValueSet), ",")
  If Len(Word) > 1 Then
    Arr = Split(Application.Trim(Replace(" " & Application.Trim(Replace(StrConv(Word, vbUnicode), Chr(0), " ")), " 0 ", " ")))
    For X = 0 To UBound(Arr)
      Arr(X) = VSet(Asc(Arr(X)))
    Next
    Do Until Join(Arr) Like "# #"
      For X = 0 To UBound(Arr) - 1
        Arr(X) = ((Arr(X) + Arr(X + 1) - 1) Mod 9) + 1
      Next
      ReDim Preserve Arr(0 To UBound(Arr) - 1)
    Loop
    WordSum = Arr(0) & Arr(1)
  Else
    WordSum = ""
  End If
End Function[/td]
[/tr]
[/table]
 
Last edited:
Upvote 0
Updated to ignore all characters whose assigned value is 0:
Code:
Option Base 1
Function WordSum(InpStr As String, Optional SetNo As Byte = 1) As Byte
    SymArr = Array(32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126)
    ValArr1 = Array(0, 0, 0, 0, 0, 0, 10, 0, 0, 0, 13, 14, 0, 0, 0, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 0, 0, 0, 0, 0, 3, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 0, 0, 0, 0, 0, 3, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 0, 0, 0, 0)
    ValArr2 = Array(0, 0, 0, 0, 0, 0, 10, 0, 0, 0, 10, 20, 0, 0, 0, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 0, 0, 0, 0, 0, 5, 1, 2, 3, 4, 5, 8, 3, 5, 1, 1, 2, 3, 4, 5, 7, 8, 1, 2, 3, 4, 6, 6, 6, 5, 1, 7, 0, 0, 0, 0, 0, 5, 1, 2, 3, 4, 5, 8, 3, 5, 1, 1, 2, 3, 4, 5, 7, 8, 1, 2, 3, 4, 6, 6, 6, 5, 1, 7, 0, 0, 0, 0)
    ValArr = Array(ValArr1, ValArr2)
    n = Len(InpStr)
    If n = 0 Then Exit Function
    ReDim TmpArr(1 To n)
    j = 0
    For i = 1 To n
        TmpArr(i) = ValArr(SetNo)(Application.Match(Asc(Mid(InpStr, i, 1)), SymArr, 0))
        If TmpArr(i) > 0 Then j = j + 1: TmpArr(j) = TmpArr(i)
    Next i
    n = j
    Select Case n
        Case 0: Exit Function
        Case 1: WordSum = TmpArr(1): Exit Function
        Case 2
            For i = 1 To 2
                TmpArr(i) = TmpArr(i) \ 10 + TmpArr(i) Mod 10
            Next i
        Case Else
            Do
            n = n - 1
            For i = 1 To n
                TmpArr(i) = ((TmpArr(i) + TmpArr(i + 1) - 1) Mod 9) + 1
            Next i
            Loop Until n = 2
    End Select
    WordSum = TmpArr(1) * 10 + TmpArr(2)
End Function

Thank you so much again! it works perfect!
 
Upvote 0
I just made a minor change to my code and now it does not matter whether you use Option Base 0 or Option Base 1 any more. Here is that revised code (and I left out the LetterSum function this time, so feel free to copy the entire code window)...
Code:
[TABLE="width: 500"]
<tbody>[TR]
[TD]Function WordSum(Word As String, ValueSet As Long) As Variant
  Dim X As Long, Arr As Variant, ValSet() As String, VSet() As String
  
[B][COLOR=#008000]  ' This section controls your Value Sets. When you add additional
  ' Value Sets, change the number after the "To" (2 at the start) to
  ' the maximum Value Set number. So, if you add two more Value Sets
  ' (3 and 4 inside the parentheses after the ValSet name), then the
  ' number that follows word "To" would be changed to 4.[/COLOR][/B]
  ReDim ValSet(1 To 2)
  ValSet(1) = "0,0,0,0,0,0,10,0,0,0,13,14,0,0,0,9,0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,3,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8 ,0,0,0,0,0,3,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,0,0,0,0"
  ValSet(2) = "0,0,0,0,0,0,10,0,0,0,10,20,0,0,0,3,0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,5,1,2,3,4,5,8,3,5,1,1,2,3,4,5,7,8,1,2,3,4,6,6,6,5,1,7 ,0,0,0,0,0,5,1,2,3,4,5,8,3,5,1,1,2,3,4,5,7,8,1,2,3,4,6,6,6,5,1,7,0,0,0,0"
  
  VSet = Split(ValSet(ValueSet), ",")
  If Len(Word) > 1 Then
    Arr = Split(Application.Trim(Replace(" " & Application.Trim(Replace(StrConv(Word, vbUnicode), Chr(0), " ")), " 0 ", " ")))
    For X = 0 To UBound(Arr)
      Arr(X) = VSet(Asc(Arr(X)))
    Next
    Do Until Join(Arr) Like "# #"
      For X = 0 To UBound(Arr) - 1
        Arr(X) = ((Arr(X) + Arr(X + 1) - 1) Mod 9) + 1
      Next
      ReDim Preserve Arr(0 To UBound(Arr) - 1)
    Loop
    WordSum = Arr(0) & Arr(1)
  Else
    WordSum = ""
  End If
End Function[/TD]
[/TR]
</tbody>[/TABLE]

Thanks a lot again! LetterSum works perfectly in all case and for WordSum small and special character gives #Value! error.
 
Upvote 0
Thanks a lot again! LetterSum works perfectly in all case and for WordSum small and special character gives #Value! error.
Sorry about that... bad editing on my part. Here is the corrected WordSum function (my version)...
Code:
[table="width: 500"]
[tr]
	[td]Function WordSum(Word As String, ValueSet As Long) As Variant
  Dim X As Long, Arr As Variant, ValSet() As String, VSet() As String
  
[B][COLOR="#008000"]  ' This section controls your Value Sets. When you add additional
  ' Value Sets, change the number after the "To" (2 at the start) to
  ' the maximum Value Set number. So, if you add two more Value Sets
  ' (3 and 4 inside the parentheses after the ValSet name), then the
  ' number that follows word "To" would be changed to 4.[/COLOR][/B]
  ReDim ValSet(1 To 2)
  ValSet(1) = "0,0,0,0,0,0,10,0,0,0,13,14,0,0,0,9,0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,3,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,0,0,0,0,0,3,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,0,0,0,0"
  ValSet(2) = "0,0,0,0,0,0,10,0,0,0,10,20,0,0,0,3,0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,5,1,2,3,4,5,8,3,5,1,1,2,3,4,5,7,8,1,2,3,4,6,6,6,5,1,7,0,0,0,0,0,5,1,2,3,4,5,8,3,5,1,1,2,3,4,5,7,8,1,2,3,4,6,6,6,5,1,7,0,0,0,0"
  
  VSet = Split(String(32, ",") & ValSet(ValueSet), ",")
  If Len(Word) > 1 Then
    Arr = Split(Application.Trim(Replace(" " & Application.Trim(Replace(StrConv(Word, vbUnicode), Chr(0), " ")), " 0 ", " ")))
    For X = 0 To UBound(Arr)
      Arr(X) = VSet(Asc(Arr(X)))
    Next
    Do Until Join(Arr) Like "# #"
      For X = 0 To UBound(Arr) - 1
        Arr(X) = ((Arr(X) + Arr(X + 1) - 1) Mod 9) + 1
      Next
      ReDim Preserve Arr(0 To UBound(Arr) - 1)
    Loop
    WordSum = Arr(0) & Arr(1)
  Else
    WordSum = ""
  End If
End Function[/td]
[/tr]
[/table]
 
Upvote 0
Sorry about that... bad editing on my part. Here is the corrected WordSum function (my version)...
Code:
[TABLE="width: 500"]
<tbody>[TR]
[TD]Function WordSum(Word As String, ValueSet As Long) As Variant
  Dim X As Long, Arr As Variant, ValSet() As String, VSet() As String
  
[B][COLOR=#008000]  ' This section controls your Value Sets. When you add additional
  ' Value Sets, change the number after the "To" (2 at the start) to
  ' the maximum Value Set number. So, if you add two more Value Sets
  ' (3 and 4 inside the parentheses after the ValSet name), then the
  ' number that follows word "To" would be changed to 4.[/COLOR][/B]
  ReDim ValSet(1 To 2)
  ValSet(1) = "0,0,0,0,0,0,10,0,0,0,13,14,0,0,0,9,0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,3,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,0,0,0,0,0,3,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,0,0,0,0"
  ValSet(2) = "0,0,0,0,0,0,10,0,0,0,10,20,0,0,0,3,0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,5,1,2,3,4,5,8,3,5,1,1,2,3,4,5,7,8,1,2,3,4,6,6,6,5,1,7,0,0,0,0,0,5,1,2,3,4,5,8,3,5,1,1,2,3,4,5,7,8,1,2,3,4,6,6,6,5,1,7,0,0,0,0"
  
  VSet = Split(String(32, ",") & ValSet(ValueSet), ",")
  If Len(Word) > 1 Then
    Arr = Split(Application.Trim(Replace(" " & Application.Trim(Replace(StrConv(Word, vbUnicode), Chr(0), " ")), " 0 ", " ")))
    For X = 0 To UBound(Arr)
      Arr(X) = VSet(Asc(Arr(X)))
    Next
    Do Until Join(Arr) Like "# #"
      For X = 0 To UBound(Arr) - 1
        Arr(X) = ((Arr(X) + Arr(X + 1) - 1) Mod 9) + 1
      Next
      ReDim Preserve Arr(0 To UBound(Arr) - 1)
    Loop
    WordSum = Arr(0) & Arr(1)
  Else
    WordSum = ""
  End If
End Function[/TD]
[/TR]
</tbody>[/TABLE]


Thank you for your time again! Now WordSum works for small &special character, but for few still it gives #Value! error.

e.g *A, A*, +A , A+ and 5*.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,943
Messages
6,181,919
Members
453,071
Latest member
Gizmo2024

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top