sum digits

[amir0914]

Hi all,
I need a vba function to compute sum of all digits in single cell, For example :

A1 = 465.5 >> 15.5
A2 = 36.3 >> 9.3
A3 = 525.63 >> 12.63
A4 = 812.03 >> 11.03

Can someone give me a vba code to do that?

[paulked]

Sub AddDigits()
Dim i As Long, j As Long, v As Long, a As Variant
For i = 1 To 4
For j = 1 To Len(Cells(i, 1))
a = Mid(Cells(i, 1), j, 1)
If IsNumeric(a) Then v = v + a
Next
Cells(i, 2) = v
v = 0
Next
End Sub

[Artik]

paulked, :no: Not all digits, only integer part.


Function SumIntDigit(Cell As Range) As Double Dim varr As Variant
Dim strDecSep As String
Dim i As Long
Dim lSum As Long

strDecSep = Application.International(xlDecimalSeparator)

varr = Split(Cell.Value, strDecSep)

For i = 1 To Len(varr(0))
lSum = lSum + Mid(varr(0), i, 1)
Next i

If UBound(varr) = 0 Then
SumIntDigit = lSum
Else
SumIntDigit = CDbl(lSum & strDecSep & varr(1))
End If
End Function
Artik

[paulked]

Sorry, missed the point totally there!

try this:



Function AddDigs(Cel As Range)
Dim i As Long, v As Long, ar
ar = Split(Cel, ".")
For i = 1 To Len(ar(0))
v = v + Int(Mid(Cel, i, 1))
Next
AddDigs = v & "." & ar(1)
End Function

[paulked]

Or if you want it as a number:



Function AddDigs(Cel As Range) As Double
Dim i As Long, v As Long, ar
ar = Split(Cel, ".")
For i = 1 To Len(ar(0))
v = v + Int(Mid(Cel, i, 1))
Next
AddDigs = CDbl(v & "." & ar(1))
End Function

[paulked]

Ha!! It sprang to mind while I was making coffee!

Thanks Artik :thumb

[Artik]

AddDigs = CDbl(v & "." & ar(1))
And when there is no fractional part will be error. :)
Artik

[paulked]

Thanks again Artik, I'm going to use a 'Get out of jail free' card here:



Function AddDigs(Cel As Range) As Double
Dim i As Long, v As Long, ar
ar = Split(Cel, ".")
For i = 1 To Len(ar(0))
v = v + Int(Mid(Cel, i, 1))
Next
On Error GoTo Oops
AddDigs = CDbl(v & "." & ar(1))
Exit Function
Oops:
AddDigs = CDbl(v)
End Function


:rofl::wot

[amir0914]

many thanks to paulked (http://www.vbaexpress.com/forum/member.php?4872-paulked) and Artik (http://www.vbaexpress.com/forum/member.php?19997-Artik). my problem has been resolved with your help.

[paulked]

Glad to have helped :thumb