Split cell contents and sum numbers
 

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

Split cell contents and sum numbers
 

Hi,

Something like that ? (with VBA)

Download the file he
http://www.cijoint.fr/cjlink.php?fil...cijxN2KgHc.xls

bye




"Steve D." <Steve a écrit dans le message de
...
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

Split cell contents and sum numbers
 

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





"Charabeuh" a écrit dans le message de
...
Hi,

Something like that ? (with VBA)

Download the file he
http://www.cijoint.fr/cjlink.php?fil...cijxN2KgHc.xls

bye




"Steve D." <Steve a écrit dans le message de
...
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

Split cell contents and sum numbers
 

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

--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


"Charabeuh" wrote:

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





"Charabeuh" a écrit dans le message de
...
Hi,

Something like that ? (with VBA)

Download the file he
http://www.cijoint.fr/cjlink.php?fil...cijxN2KgHc.xls

bye




"Steve D." <Steve a écrit dans le message de
...
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