Could you please help me with this function again?
It seems that I didnt test it enough and it's returning some inaccurat
results.


Function sum_pseudo_time(rng As Range) As String
Dim cell As Range
Dim ret_str As String
Dim ret_value
Dim time_str As String

ret_value = 0
For Each cell In rng
If cell.Value < "" Then
time_str = Replace(Replace(Replace(cell.Value, "H", ""), _
"M", ""), _
"D", "")
ret_value = ret_value + CDate(time_str)
End If
Next
With Application.WorksheetFunction
ret_str = .RoundDown(ret_value, 0) & "D:" & _
.RoundDown((ret_value - .RoundDown(ret_value, 0)) * 24, 0) & _
"H:" & CInt((ret_value * 24 - .RoundDown(ret_value * 24, 0)) * 60) & _
"M"
End With
sum_pseudo_time = ret_str
End Function


I'm trying to add:

12D:20H:36M
12D:17H:20M
12D:1H:32M
and it's giving me: 1D:12H:39M

this of course should be: 37D:15H:28M

TIA Frank!

- Larry -
VBA Amateu

--
Message posted from http://www.ExcelForum.com

Hi
will look into this mabe later this evening but for now:
This function was developed for pseudo times like
xxH:yyM:nnS

and not using days as input parameter. So the values you
put into this function are currently evaluated as
HH:MM:SS. This leads to the incorrect results. So the
calculation has to be changed as well.
Do you also want to include 'pseudo' seconda as argument?

-----Original Message-----
Could you please help me with this function again?
It seems that I didnt test it enough and it's returning
some inaccurate
results.


Function sum_pseudo_time(rng As Range) As String
Dim cell As Range
Dim ret_str As String
Dim ret_value
Dim time_str As String

ret_value = 0
For Each cell In rng
If cell.Value < "" Then
time_str = Replace(Replace(Replace(cell.Value, "H", ""), _
"M", ""), _
"D", "")
ret_value = ret_value + CDate(time_str)
End If
Next
With Application.WorksheetFunction
ret_str = .RoundDown(ret_value, 0) & "D:" & _
.RoundDown((ret_value - .RoundDown(ret_value, 0)) * 24,
0) & _
"H:" & CInt((ret_value * 24 - .RoundDown(ret_value * 24,
0)) * 60) & _
"M"
End With
sum_pseudo_time = ret_str
End Function


I'm trying to add:

12D:20H:36M
12D:17H:20M
12D:1H:32M
and it's giving me: 1D:12H:39M

this of course should be: 37D:15H:28M

TIA Frank!

- Larry -
VBA Amateur


---
Message posted from http://www.ExcelForum.com/

.

What is 'pseudo' seconda?

When you mentioned about changing the calculation, you mean the 3 las
syntax lines right?

ret_str = .RoundDown(ret_value, 0) & "D:" & _
.RoundDown((ret_value - .RoundDown(ret_value, 0)) * 24, 0) & _
"H:" & CInt((ret_value * 24 - .RoundDown(ret_value * 24, 0)) * 60)
"M"

I've been playing with the numbers with no success so far... I'm goin
to see if I can locate additional sources to aid me in the calculation
One thing did bear a close result for the "D" factor... adding th
following: to the 1st line

ret_str = .RoundDown(ret_value * 24, 0) this resulted in 36D

Thanks so much Frank... I'm going to keep trying to see if I can figur
this one out.

- Larry - :)
VBA Amateu

--
Message posted from http://www.ExcelForum.com

Hello Larry

The following has been given limited testing, but it did seem to work as your specified on your strings/targeted output

Public Function AddStringDates(ByVal myRng As Range) As Strin
Dim myArr As Variant, myArr2 As Variant, i As Long, i2 As Lon
Dim tmpVal As Doubl
Let myArr = WorksheetFunction.Transpose(myRng.Value
If Not IsArray(myArr) The
Let myArr2 = Split(myArr, ":"
For i = LBound(myArr2) To UBound(myArr2
tmpVal = tmpVal + Choose(i + 1, Val(myArr2(i)),
Val(myArr2(i)) / 24, Val(myArr2(i)) / 1440

Nex
Els
For i2 = LBound(myArr) To UBound(myArr
Let myArr2 = Split(myArr(i2), ":"
For i = LBound(myArr2) To UBound(myArr2
tmpVal = tmpVal + Choose(i + 1, Val(myArr2(i)),
Val(myArr2(i)) / 24, Val(myArr2(i)) / 1440
Nex
Nex
End I
AddStringDates = Int(tmpVal) &
Format$(tmpVal, """D:""hh""H:""mm""M"""
End Functio

Best Regards
Nate Oliver