I am working on a function for an asp page that compares if a time entered is greater than a time with added leeway. I noticed certain times when checked would fail the test when the times are equal. Included is a snip of my function to illustrate. Not sure why equal dates would fail, and would like to know if this is a good way to go about comparing time.
<%
function TimeTest(testTime, checkTime, buffer, try)
checkingTime = FormatDateTime(cdate(DateAdd("n", buffer, cdate(checkTime))),4)
if try = 1 then
testTime = FormatDateTime(testTime, 4)
checktime = FormatDateTime(checkTime, 4)
end if
if cdate(testTime) > DateAdd("n", buffer, cdate(checkTime)) then
TimeTest = "<p class = 'redS'>Fails! testTime: "&testTime&" < checkTime:"&checkingTime&"</p>"
else
TimeTest = "<p class = 'greenS'>Works! testTime: "&testTime&" > checkTime:"&checkingTime&"</p>"
end if
end function
response.write("<br><br><h1>Test2</h1><br>")
for i=0 to 23
for j=0 to 59
response.write(TimeTest(i&":"&j&":00", i&":00:00", j, 1))
response.write("<BR>")
next
next
%>
This problem has earned my attention! I can reproduce the results and it's very unclear what's going on behind the scenes in these comparisons. However, I have a workaround for you
Here is a modified version of the code that I've been using to analyse the issue...
<%
Option Explicit
Function TimeTest(a, b, buffer)
Dim c : c = DateAdd("n", buffer, b)
Dim s : s = Join(Array("a=" & a, "b=" & b, "c=" & c, "buffer=" & buffer), ", ")
Dim passed : passed = a <= c
'Dim passed : passed = DateDiff("s", a, c) <= 0
If passed Then Exit Function
Dim color : color = "red" : If passed Then color = "green"
TimeTest = "<div style='color:" & color & "'>" & s & "</div>"
End Function
Dim i, j, a, b
For i = 0 To 23
For j = 0 To 59
a = CDate(i & ":" & j & ":00")
b = CDate(i & ":00:00")
'a = CDate(Date() & " " & i & ":" & j & ":00")
'b = CDate(Date() & " " & i & ":00:00")
Response.Write(TimeTest(a, b, j))
Next
Response.Write("<hr>")
Next
%>
Note that commenting out line 13 will reveal lines that pass. By default, I'm showing only failures.
The first thing to note is that I have some commented variants on lines 24-25 where I add today's date to the value before casting it. Interestingly, doing this changes the pattern of which times fail the test. There are still roughly the same number of failures but they occur at different buffer values.
This leads me to believe that behind the scenes in VBScript, these datetimes might be cast to floating-point numbers when you use the native < <= > >= comparison operators on them and that's resulting in some precision errors. If they were converted to long integers, then they should surely be correct.
I did a version of the code where instead of using a direct comparison on the VBDateTimes, I compared the integer representation of them (unix time) using this function:
Function date2epoch(myDate)
date2epoch = DateDiff("s", "01/01/1970 00:00:00", myDate)
End Function
When doing that, all tests passed. However, it is an unusual way to do things. I thought there should be a more 'normal' way.
I then went back and replaced the straightforward <= operator with a call to DateDiff instead (comment out line 10, uncomment line 11). Whether I used seconds or minutes, the tests passed. So, I think the takeaway lesson here might be to always use DateDiff when comparing VBDateTimes. As someone who's used VBS for a while and never encountered issues with native comparisons before, this is a revelation and I may need to offer this advice to my colleagues too.
Related
I have a code where I have an inputbox where I usually copy in some numbers.
I need vba to handle these and pass them to the cell as european format.
The format that comes in is US and comes as:
##,### ## ##
I use the following code to transform it to the format I want:
dim earned as variant
earned = Replace(Me.txtEarnedG.Value, ".", "")
earned = Replace(earned, ",", "")
earned = Replace(earned, " ", "")
earned = Left(earned, Len(earned) - 4) & "," & Right(earned, 4)
amount_earned = CDbl(earned)
This works perfectly and would transform
35,545 45 55 (US format with spaces, without a ".")
into
35545,4555 (EU format)
My issue comes when I try to transform a number that doesn't 2 digits in between one of the spaces like,
35,545 4 13 becomes 3554,5413 instead of 35545,0413
35,545 12 4 becomes 3554,5124 instead of 35545,1204
I was thinking of using Instr and right in some way. But I can't figure on how to introduce it in easily. (The number should always finish with 4 decimal places, but the rest may vary and can be bigger or smaller than thousands)
I think you could use the Split function as #Porcupine suggests and combine with Format to get the number format you wanted.
A simple example using your numbers below
Public Sub test()
Const TEST_NUM1 = "35,545 4 13"
Const TEST_NUM2 = "35,545 12 4"
Const TEST_NUM3 = "35,545 45 55"
FormatAsEU TEST_NUM1
FormatAsEU TEST_NUM2
FormatAsEU TEST_NUM3
End Sub
Public Function FormatAsEU(strNumber As String) As String
Dim varInput As Variant
varInput = Split(strNumber, " ")
FormatAsEU = Format(varInput(0), "#.#") & Format(varInput(1), "00") & Format(varInput(2), "00")
Debug.Print FormatAsEU
End Function
Debug Results:
> 35545.0413
> 35545.1204
> 35545.4555
i have a code that copies and rewrites anything thats between "(" and ")", but now i have different type of data which do not end with ")" so, i need it to stop when it reaches the last character in cell. Maybe it is dumb question but i cant seem to find how to fix my problem. I am a student and total newbie in vba (5 days ago i didn't know what vba is...) also sorry for my bad english.
I've tried to search (in here, google, youtube) but i couldnt find anything i need
'zaciatok=start koniec=end dlzka=length
Do While Mid(LookInHere, y, 1) <> ""
If Mid(LookInHere, Z, 1) = "(" Then
zaciatok = Z
End If
If Mid(LookInHere, y, 1) = ")" Then
koniec = y
dlzka = (koniec - 1) - zaciatok
dlzka = Abs(dlzka)
SplitCatcher = Mid(LookInHere, zaciatok + 1, CStr(dlzka))
MsgBox SplitCatcher
End If
y = y + 1
Z = Z + 1
Loop
In your specific implementation, one option is to modify your Do While ... loop to also test against the length of the string. That line would look something like:
Do While Mid(LookInHere, y, 1) <> "" And y < Len(LookInHere)
That modification tells the statement that it should terminate the loop when the iterating variable y goes past the length of the statement.
Another option is to change it from a Do While loop to a For loop. It would read something like:
For i = 1 to Len(LookInHere)
MsgBox Mid(LookInHere, i, 1)
'Input your logic here
Next i
The problem is that each of these versions is relatively inefficient, looping through each letter in a string a performing a calculation. Consider using built-in Excel functions. The Instr returns the position of a character, or a zero if it is not found. As an example, Instr("Abcdef", "b") would return the number 2, and Instr("Abcdef", "k") would return zero. You can replace the entire loop with these two function calls.
Z = Instr(LookInHere, "(")
y = Instr(LookInHere, ")")
If y = 0 Then y = Len(LookInHere)
Final note: if your patterns begin to get more and more complex, consider reviewing and implementing regular expressions.
You can use Right(LookInHere, 1) to get the last character of LookInHere
I'm trying to populate an array which is composed of greek letters followed by a subscript "1". I already have the greek letters part:
Dim variables(), variables_o
j = 0
For i = 1 To 25
If i = 13 Or i = 15 Then
Else
j = j + 1
ReDim Preserve variables(j)
variables(j) = ChrW(944 + i)
End If
Next
But I'm having trouble with the subscript part. I figure that if I could use the with ... end with feature then I could do it but I'm having trouble figuring out what objects the with ... end with can take. On this website they say:
With...End With Statement (Visual Basic)
The data type of objectExpression can be any class or structure type or even a Visual Basic elementary type such as Integer.
But I don't know what that means. If could do something like this:
dim one as string
one = "1"
with one
font.subscript = true
end with
Then I could figure out how to do what I want. But the with feature does not seem to act on strings. The problem I'm having is that most of the advice for fonts somewhere along the line use the cell method but I want to populate an array, so I'm having trouble. Again what I would ideally like to do is create some dimension which is simply a subscripted one and then alter my array as follows:
Dim variables(), variables_o
j = 0
For i = 1 To 25
If i = 13 Or i = 15 Then
Else
j = j + 1
ReDim Preserve variables(j)
variables(j) = ChrW(944 + i) & subscript_one
End If
Next
To my knowledge, there are no out-of-the-box methods or properties to store the font.Subscript property of a character or series of characters within a string that also contains the characters.
You could use inline tags, like in HTML, to indicate where the subscript begins and ends. For example:
variables(j) = ChrW(944 + i) & "<sub>1</sub>"
Then, when you write out variable, you would parse the string, remove the tags and set the font.Subscript property accordingly.
However, if you're always appending a '1' to each Greek letter, I would just append it to the string, then set the font.Subscript property on the last character of the string when outputting it. For example:
variables(j) = ChrW(944 + i) & "1"
...
For j = 0 to Ubound(variables)
With Worksheets("Sheet1").Cells(j + 1, 1)
.Value = variables(j)
.Characters(Len(variables(j)), 1).Font.Subscript = True
End With
Next j
If you're writing to something other than a cell in a worksheet, it has to support Rich-Text in order for the subscript to show, e.g. a Rich-Text enabled TextBox on a user form. You should be able to use the .Characters object on those controls in a similar manner.
See MSDN-Characters Object for more information.
I am trying to make a certain string with Digits change form, so that it looks like below.
Modified to show with Digits instead of X.
So let´s set, i get a number, like this.
234.123123123
I need to change how it appears, for 3 digits before a Dot, it would need to become.
0.234123123123
And let´s say it´s 2.23123123123, that would become, 0.0023123123123
Now i will try to explain the Formula, bare with my English.
The formula needs to change the position of the Dot ".".
You can see that it changes place, But you can also see that i am adding 0s.
That is important, the 0s needs to be added IF the dot get´s to the far left (the beginning of the string).
So how much must the Dot move?
The Dot must Always move 3 steps to the left.
And if it hit´s the wall (the start of the string) you need to add 0s, and then one 0s before the dot.
So if the number is, 2.222222
I will first have to move the dot to the left, let´s show step by step.
Step 1:
.2222222
Step 2:
.02222222
Step 3:
0.02222222
It must Always be a 0 Before the Dot, it it ever hit the Start.
It sounds more complicated then it is, it´s just that i don't know how to explain it.
EDIT:
My attempt:
TextPos = InStr(1, TextBox4.Value, ".") - 2
If (TextPos = 4) Then
sLeft = Left(TextBox4.Value, Len(TextBox4.Value) - Len(TextBox4.Value) + 2)
sRight = Right(TextBox4.Value, Len(TextBox4.Value) - 2)
sFinal = (sLeft & "." & Replace(sRight, ".", ""))
TextBox4.Value = Replace(sFinal, "-", "")
End If
If (TextPos = 3) Then
TextBox4.Value = "0." + Replace(TextBox4.Value, ".", "")
End If
If (TextPos = 2) Then
TextBox4.Value = "0.0" + Replace(TextBox4.Value, ".", "")
End If
If (TextPos = 1) Then
TextBox4.Value = "0.00" + Replace(TextBox4.Value, ".", "")
End If
TextBox4.Value = Replace(TextBox4.Value, "-", "")
If i /1000 it, may work, but it seems like it will alter the number, leaving it to fail.
Original: 25.1521584671082
/1000 : 2.51521584671082E-02
As you can see, it doesn't work as expected.
It should become 0.0251521584671082E-02 (And of course i don't want " E- " to be there.
So if it's possible to do this, but ONLY moving and not actually, dividing (i think excel is limited to how many numbers it can calculate with) then it will work.
Worth Noting, the numbers shown are actually less (shorter) then the real number for some reason, if i write it down to a text file, it becomes this:
2.51521584671082E-02251521584671082E-02
So as you can see, i probably hit a Wall in the calculation, so it changes to Characters (I know math uses those, but no idea what they mean, and they are useless for me anyway).
And i think it's because of them that it fails, not sure though.
EDIT:
Okay, by limiting to 15 decimals it will return the correct place, but i would like not to do this round about, should Excel really be limited to only 15 Decimals, or is it "Double,Float etc" that does this?
EDIT 2:
Tony's example provides this:
Original: 177.582010543847177582010543847
Tony's: 0.1775820110177582011
Round(15decimals): 0.1775820105438470177582010543847
Not really sure, but isn't it Incorrect, or perhaps i did something wrong?
If possible, i want ALL decimals and number to stay in place, as everything is already correct, it's just that they are in the wrong place.
/1000 solves this, but not in the best way, as it will recalculate instead of just moving.
Normally i wouldn't care, the results are the same, but here it does matter as you can see.
I can however think of a solution, where i till look for the position of the Dot, then cut out the last decimals, divide the Result by 1000, then later add the last decimals, though that is more of a hack , not sure if it will actually work.
I conclude that this is Answered, it does what i want, and the limitations is in the Calculation itself, not the Solution.
All Solutions work pretty much in the same way, but i chose Tony's as he was first to comment the solution in my question.
Many Thanks everyone!
It appears to me through all your edits that you want to divide the number by one thousand. To do this, you can simply use
TextBox4.Value = TextBox4.Value / 1000
You code sometimes fails because it does not handle every situation. You calculate TextPos so:
TextPos = InStr(1, TextBox4.Value, ".") - 2
You then handle TextPos being 4, 3, 2 or 1. But if, for example, TextBox4.Value = "2.22222" then TextPos = 0 and you have no code for that situation.
At 11:45 GMT, I suggested in a comment that dividing by 1000 would give you the result you seek. At 14:08 GMT, tunderblaster posted this as an answer. It is now 15:23 but you have not responded to either of us.
Having tried your code, I now know these answer do not match the result it gives when it works because you remove the sign. The following would give you almost the same as a working version of your code:
TextBox4.Value = Format(Abs(Val(TextBox4.Value)) / 1000, "#,##0.#########")
The only deficiency with this statement is that it does not preserve all the trailing decimal digits. Is this really important?
While I was preparing and posting this answer, you edited your question to state that dividing by 1000 would sometimes give the result in scientific format. My solution avoids that problem.
If you want to avoid floating point error when dividing by 10, you may use the Decimal type
Private Sub CommandButton1_Click()
Dim d As Variant
d = CDec(TextBox1.Text)
TextBox1.Text = d / 1000
End Sub
Is this what you are trying?
Sub Sample()
Dim sNum As String, SFinal As String
Dim sPref As String, sSuff As String
Dim nlen As Long
sNum = "234.123123123123123123131231231231223123123"
SFinal = sNum
If InStr(1, sNum, ".") Then
sPref = Trim(Split(sNum, ".")(0))
sSuff = Trim(Split(sNum, ".")(1))
nlen = Len(sPref)
Select Case nlen
Case 1: SFinal = ".00" & Val(sPref) & sSuff
Case 2: SFinal = ".0" & Val(sPref) & sSuff
Case 3: SFinal = "." & Val(sPref) & sSuff
End Select
End If
Debug.Print SFinal
End Sub
Try this. It works by initialy padding the string with leading 0's, shifting the DP, then removing any unnecassary remaining leading 0's
Function ShiftDecimalInString(str As String, Places As Long) As String
Dim i As Long
If Places > 0 Then
' Move DP to left
' Pad with leading 0's
str = Replace$(Space$(Places), " ", "0") & str
' Position of .
i = InStr(str, ".")
str = Replace$(str, ".", "")
If i > 0 Then
' Shift . to left
str = Left$(str, i - Places - 1) & "." & Mid$(str, i - Places)
' strip unnecassary leading 0's
Do While Left$(str, 2) = "00"
str = Mid$(str, 2)
Loop
If str Like "0[!.]*" Then
str = Mid$(str, 2)
End If
ShiftDecimalInString = str
Else
' No . in str
ShiftDecimalInString = str
End If
ElseIf Places < 0 Then
' ToDo: Handle moving DP to right
Else
' shift DP 0 places
ShiftDecimalInString = str
End If
End Function
This "answer" responses to the issue that you want as much precision in the result as possible.
When I was at school this was called spurious accuracy. I have forgotten most of my mathematics in this area but I will try to give you an understanding of the issue.
I have a value, 2.46, which is accurate to 2 decimal places. That is the true value is somewhere in the range 2.455 to 2.465.
If I feed these values into a square root function I will get:
sqrt(2.455) = 1.566843961599240
sqrt(2.46) = 1.568438714135810
sqrt(2.465) = 1.570031846810760
From this I see the square root of the true value is somewhere between 1.567 and 1.570; any extra decimal digits are spurious.
If I understand correctly, you wish to use these numbers to make adjustments. Are you capable of making adjustments to 15 decimal digits?
If you remember your calculus you can look up "propogation of error" for a better explanation.
Is it Possible in VBScript to convert such 20:72:84(hh:mm:ss) duration to 21:13:24 (hh:mm:ss) format?
Yes obviously we can Loop through it but I want to avoid such Loopy technique.
CODE
As per the Siddharth solution - I just modified the code as it to fit with VBScript platform
Option Explicit
Dim S
S=Convert("23:61:61")
MsgBox(s)
Function Convert(strTime) 'As String
Dim timeArray()
Dim h , m , s
MsgBox("Hi")
'On Error Resume Next
timeArray = Split(strTime, ":")
h = timeArray(0): m = timeArray(1): s = timeArray(2)
REM If err then
REM MsgBox(err)
REM err.clear
REM Exit Function
REM End if
Do Until s < 60
s = s - 60
m = m + 1
Loop
Do Until m < 60
m = m - 60
h = h + 1
Loop
Do Until h < 24
h = h - 24
Loop
Convert = Format(h, "00") & ":" & Format(m, "00") & ":" & Format(s, "00")
'on Error Goto 0
'Exit Function
'Whoa:
'Convert = "Error! CYDD!" '<~~ CYDD : Check Your Data Dude :)
End Function
EDIT1 I am getting an error as Type mismatch to the line timeArray = Split(strTime, ":")
Thanks,
Split the array
Add each part to an empty time using dateadd()
rebuild the time to a well formatted string using a stringbuilder
' This splits the string in an hours, minutes and seconds part.
' the hours will be in dArr(0), minutes in dArr(1) and seconds in dArr(2)
dArr = split("20:72:84", ":")
' Add the hours to an empty date and return it to dt1
dt1 = dateadd("h", dArr(0), empty)
' Add the minutes to dt1. Note: Minutes are noted as "n" and not "m" because the
' "m" is reserved for months. To find out more about the dateadd() please look here:
' http://www.w3schools.com/vbscript/func_dateadd.asp
' When the minutes are bigger than they fit in the date, it automatically falls over to
' next hour.
dt1 = dateadd("n", dArr(1), dt1)
' Also add the seconds (the third part of the array) to dt1, also the seconds
' automatically fall over when too large.
dt1 = dateadd("s", dArr(2), dt1)
' Now that we created a date, we only have to format it properly. I find it the most easy
' way to do this is with a dotnet stringbuilder, because we can separate code and
' format. The CreateObject creates the stringbuilder. We chain the AppendFormat
' and the ToString methods to it, so actually these are three statements in one.
' Mind the HH in the HH:mm:ss format string, hh means 12 hour notation, HH means 24
' hour notation.
msgbox CreateObject("System.Text.StringBuilder").AppendFormat("{0:HH:mm:ss}", dt1).toString()
outputs 21:13:24
EDIT: Extra comments by request of TS
Is this what you are trying?
Option Explicit
Sub Sample()
Debug.Print Convert("23:61:61")
Debug.Print Convert("24:61:61")
Debug.Print Convert("20:72:84")
Debug.Print Convert("Hello World")
End Sub
Function Convert(strTime As String) As String
Dim timeArray() As String
Dim h As Long, m As Long, s As Long
On Error GoTo Whoa
timeArray = Split(strTime, ":")
h = timeArray(0): m = timeArray(1): s = timeArray(2)
Do Until s < 60
s = s - 60
m = m + 1
Loop
Do Until m < 60
m = m - 60
h = h + 1
Loop
Do Until h < 24
h = h - 24
Loop
Convert = Format(h, "00") & ":" & Format(m, "00") & ":" & Format(s, "00")
Exit Function
Whoa:
Convert = "Error! CYDD!" '<~~ CYDD : Check Your Data Dude :)
End Function
SNAPSHOT
EDIT (FOLLOWUP)
The code that I gave above is for VBA-Excel (as it is one of your tags)
For VB-Script, use this code
MsgBox Convert("23:61:61")
MsgBox Convert("24:61:61")
MsgBox Convert("20:72:84")
MsgBox Convert("Hello World")
Function Convert(strTime)
Dim timeArray
Dim h, m, s, hh, mm, ss
On Error Resume Next
timeArray = Split(strTime, ":", -1, 1)
h = timeArray(0): m = timeArray(1): s = timeArray(2)
If Err Then
Err.Clear
Exit Function
End If
Do Until s < 60
s = s - 60
m = m + 1
Loop
Do Until m < 60
m = m - 60
h = h + 1
Loop
' As per latest request
'Do Until h < 24
'h = h - 24
'Loop
If Len(Trim(h)) = 1 Then hh = "0" & h Else hh = h
If Len(Trim(m)) = 1 Then mm = "0" & m Else mm = m
If Len(Trim(s)) = 1 Then ss = "0" & s Else ss = s
Convert = hh & ":" & mm & ":" & ss
On Error GoTo 0
End Function
HTH
This seems to be quite obviously an "XY Problem": the OP is seeking a workaround to deal with a malformed piece of data, instead of figuring how the data is becoming malformed in the first place (and preventing it from happening).
20:72:84 is not a logical representation of duration by any standard, and whatever created that string is erroneous.
Technically, according to ISO-8601 (considered the "international standard for covering exchange of date and time related data"), duration should be expressed as PnYnMnDTnHnMnS.
That said, I would also opt for HH:MM:SS... but it should [obviously?] never show more than 59 seconds or 59 minutes, any more than our decimal (aka, Base 10) number system should count ...0.8, 0.9, 0.10, 0.11.... (lol, "zero point eleven")
Fixing the Duration
Regardless, it's an old question and we don't know how you got this strange number, but as others have suggested, I would use Split to fix it, although my preference is a more compressed form:
Function fixWonkyDuration(t As String) As String
fixWonkyDuration = Format(((Split(t, ":")(0) * 60 + Split(t, ":")(1)) _
* 60 + Split(t, ":")(2)) / 86400, "HH:mm:ss")
End Function
The function above will fix a "wonky" duration by converting each section into seconds, summing, then converting temporarily to a Date before using Format to display it as intended.
It's important to note that neither the input nor output is a valid Excel DateTime (Date), so both are declared as Strings.
Example Usage:
MsgBox fixWonkyDuration("20:72:84") 'returns "21:13:24"
Convert to Seconds (for comparison, calculations, etc)
Incidentally, when you have a valid duration in HH:MM:SS format, but want to do calculations or comparisons with it, it's easiest to first convert it to seconds with the help of TimeValue and CDbl.
The quickest method:
Function DurationToSeconds(d As String) As Long
DurationToSeconds = CDbl(TimeValue(d)) * 86400#
End Function
Example Usage:
MsgBox DurationToSeconds("21:13:24") 'returns 76404
Well, you can split into 3 variables: h,m and s. And then check if s>60. And if it is, m=m+s/60 and s=s%60. The same for the m variable:
if(m>60) then
h=h+m/60
m=m%60
Then, concate h, m and s.
This is too much text to put in a comment.
When you enter 20:72:33 into any cell that is on General format it will show you a serial number. E.g. 0.883715278
Then you change the cell format to Time. And it gives you the format and data you want to see.
HOWEVER,
The above statement only works as long as your seconds are below 60. If you enter 60, 61, 84, '100', etc. It doesn't work.
So perhaps you can jam it like all the jamming codes perhaps you are using right now. ;)
It's as ugly as it could get. Do mod 60 on seconds and then change cell format to Time. Or just as might as use what Alex shows up there in his answer. It's clean and gurantees your the desired output mathematically.