Split cell contents and sum numbers

[Steve D.]

Hi all, let me say thanks in advance for any help you can offer. In cells D5
- AH5, there can be data that looks like V8, T8Z4, LM8, C10, or S8, etc. What
I would like to do is to strip the letter(s) and sum the numbers in a
seperate cell for each letter code. In the below example, A3-F3 contain the
codes, and K3-O3 contain the total sum of the numbers following the letters.

A B C D E F G H I J K L
M N O
1
2 V
C T Z LM
3 v8 c10 T8 V4 LM2 T8Z4 12 10 16
4 2
4

Thanks for any help you might be able to offer me. Steve

 

[Charabeuh]

Hi,

Something like that ? (with VBA)

Download the file here:
http://www.cijoint.fr/cjlink.php?file=cj200907/cijxN2KgHc.xls

bye

 

[Charabeuh]

The code:

Option Explicit

Public Sub TEST()
SplitSum Range("A3:F3"), Range("A5")
End Sub


Public Sub SplitSum(RangeOfValue As Range, _
DestinationCell As Range)

Dim Firstline, SecondLine, xCell
Dim Firstcol, LastCol, X, i, j, Strg, Num, Car, Maxi
Dim Found As Boolean

Firstline = DestinationCell.Range("A1").Row
SecondLine = Firstline + 1
Firstcol = DestinationCell.Range("A1").Column
LastCol = 0

Rows(Firstline).ClearContents
Rows(SecondLine).ClearContents

For Each xCell In RangeOfValue
X = Trim(UCase(xCell.Value))
Maxi = Len(X)
If Maxi <> 0 Then
j = 1

While j <= Maxi
Strg = "": Num = ""
Car = Mid(X, j, 1)

While Car >= "A" And Car <= "Z" And j <= Maxi
Strg = Strg & Car
j = j + 1
Car = Mid(X, j, 1)
Wend
While Car >= "0" And Car <= "9" And j <= Maxi
Num = Num & Car
j = j + 1
Car = Mid(X, j, 1)
Wend

Found = False
For i = Firstcol To LastCol
If Cells(Firstline, i) = Strg Then
Cells(SecondLine, i).Value = _
Cells(SecondLine, i).Value + Num
Found = True
Exit For
End If
Next i
If Not Found Then
LastCol = LastCol + 1
Cells(Firstline, LastCol).Value = Strg
Cells(SecondLine, LastCol).Value = _
Cells(SecondLine, LastCol).Value + Num
End If
Wend
End If
Next

End Sub

 

[ryguy7272]

Try this:
Function SumCharacters(rng As Range) As Long

Dim i As Long
Dim s As String
Dim lSum As Long
Dim myCell As Range

lSum = 0
For Each myCell In rng.Cells
For i = 1 To Len(myCell.Value)
s = Mid(myCell.Value, i, 1) 'mycell.text if it's formatted
If IsNumeric(s) Then
lSum = lSum + s
End If
Next i
Next myCell

SumCharacters = lSum
End Function

Call is as such:
=SumCharacters(A1)

Or............
=SumCharacters(A1:A2)

HTH,
Ryan---