Frank Kabel

  • Thread starter Thread starter nrage21
  • Start date Start date
N

nrage21

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
 
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?
 
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
 
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
 
Thanks Nate it work for the 3 time sets that I posted,... I wil
continue testing the code.

- Larry -
VBA Amateu
 
Testing the code I made the following discovery,... when I have

1D:14H:36M
15H:19M

the function yields: 17D:09H:36M
the function things 15 is the "Day"


However, When I add "0D:" to the 2nd time it yields the correc
result...2D:05H:55M

So I have decided to work around this problem and add "0D" to all tim
sets that don't have "D"(Day) in it.

- Larry
 
Back
Top