I know this has been asked quite a bit, but for some reason none of the solutions seem to work for me.
I have a unix time stamp (for example purposes use 1637402076084)
On my excel sheet I can convert that fine using
= (C2/ 86400000) + DATE(1970,1,1)
However I want to do this in my VBA code as there's a lot of data and I prefer doing it all in an array then applying my array to the sheet (for performance purposes)
However in my code I'm trying to use dateAdd
DateAdd("s", 1637402076084#, "1/1/1970 00:00:00")
but I get an overflow error
I'm assuming this is because the unix timestamp is too big? But it's one that gets returned from an api call and is a geniune one (as demonstrated by the formula) but I'm not sure why my code isn't working.
There are two types of UNIX timestamps. 10 digits and 13 digits. The function you try using is for 10 digits type. To convert the 13 digits type, you should create another function, exactly as you use in the cell:
Function fromUNIX13Digits(uT) As Date
fromUNIX13Digits = CDbl(uT) / 86400000 + DateSerial(1970, 1, 1)
End Function
And test it as:
Sub testFromUNIX13()
Debug.Print fromUNIX13Digits("1637402076084")
End Sub
For 10 digits type, you can use:
Public Function fromUnix10(ts) As Date
fromUnix10 = DateAdd("s", CDbl(ts), "1/1/1970")
End Function
And test it using:
Sub testFromUnix10()
Debug.Print fromUnix10("1651680385")
Debug.Print Format(fromUnix10("1651680385"), "yyyy/mm/dd hh:nn:ss")
End Sub
Or build a function able to deal with both types:
Function FromUNIX(uT) As Date
If Len(uT) = 10 Then
FromUNIX = DateAdd("s", CDbl(uT), "1/1/1970")
ElseIf Len(uT) = 13 Then
FromUNIX = CDbl(uT) / 86400000 + DateSerial(1970, 1, 1)
Else
MsgBox "No UNIX timestamp passed to be converted..."
End If
End Function
And test it using:
Sub testFromUnix_()
Dim x As String, y As String
x = "1637402076084"
y = "1651680385"
Debug.Print FromUNIX(x)
Debug.Print FromUNIX(y)
End Sub
Related
I'm working with government harmonized codes. They're formatted as 10 numbers with periods between the 4th and 5th characters, and six-seventh characters like this "1234.56.7890". I'm trying to do some validation work so when a user enters a number without the periods, which is often the case, it puts the periods in for them.
The harmonized code is a variable in this instance named dimmed tv as a string.
Here's the code I'm using:
tv = Format(tv, "####.##.####")
Problem is, when I input 1234567890, it converts it instead to 1234567890.. with the two periods at the end. Any idea how I can get it to convert it to 1234.56.7890 as my code implies it should?
I'd do it like this:
Sub tester()
Dim e
For Each e In Array("1234.56.7899", "123456.7899", "1234.567899", _
"1234567899", "123A567899", "123456789")
Debug.Print e, ValidTv(e)
Next e
End Sub
'check format and return normalized value if possible
' return empty string if valid value can't be created
Function ValidTv(ByVal tv As String) As String
If tv Like "####.##.####" Then
ValidTv = tv
Else
tv = Replace(tv, ".", "")
If tv Like "##########" Then
ValidTv = Left(tv, 4) & "." & Mid(tv, 5, 2) & "." & Right(tv, 4)
End If
End If
End Function
I am attempting to parse out clean target DATES from cells populated with free form TEXT STRINGS.
ie: TEXT STRING: "ETA: 11/22 (Spring 4.5)" or "ETA 10/30/2019 EOD"
As you can see, there is no clear standard for the position of the date in the string, rendering LEFT or RIGHT formulas futile.
I tried leveraging a VBA function that I found which essentially breaks up the string into parts based on spaces in the string; however it has not been working.
Public Function GetDate(ResNotes As String) As Date
Dim TarDate As Variant
Dim part As Variant
TarDate = Split(ResNotes, " ")
For Each part In ResNotes
If IsDate(part) = True Then
GetDate = part
Exit Function
End If
Next
GetDate = "1/1/2001"
End Function
I'm referring to the cells with text strings as "ResNotes", short for "Resolution Notes" which is the title of the column
"TarDate" refers to the "Target Date" that I am trying to parse out
The result of the custom GETDATE function in Excel gives me a #NAME? error.
I expected the result to give me something along the lines of "10/30/2019"
Unless you need VBA for some other part of your project, this can also be done using worksheet formulas:
=AGGREGATE(15,6,DATEVALUE(MID(SUBSTITUTE(A1," ",REPT(" ",99)),seq_99,99)),1)
where seq_99 is a named formula and refers to:
=IF(ROW($A$1:INDEX($A:$A,255,1))=1,1,(ROW($A$1:INDEX($A:$A,255,1))-1)*99)
*seq_99 generates an array of numbers {1;99;198;297;396;495;...
Format the cell with the formula as a Date of some type.
If there are no dates, it will return an error which you can either leave, or wrap the function in an IFERROR(your_formula,your_error_message)
Algorithm
Split the cell on the spaces
Replace each space with 99 spaces
Using the MID function, return an array of substrings 99 characters long
Apply the DATEVALUE function which will return either an error (if the substring is not a date) or a date serial number.
Since dates in Excel are serial numbers since 1/1/1900, we can use the AGGREGATE function to pick out a value, and ignore errors.
If you are getting #NAME then the code is not stored in a general module. It should NOT be in a worksheet module or ThisWorkbook module.
Also there are few errors in the code. Split returns a String Array. And since IsDate returns TRUE/FALSE the = True is not needed.
As per #MathieuGuindon we can change the string to a date in the code if found and return an error if not. For that we need to allow the return to be a variant.
Public Function GetDate(ResNotes As String)
Dim TarDate() As String
Dim part As Variant
TarDate = Split(ResNotes, " ")
For Each part In TarDate
If IsDate(part) Then
GetDate = CDate(part)
Exit Function
End If
Next
GetDate = "1/1/2001"
'Instead of a hard coded date, one can return an error, just use the next line instead
'GetDate =CVErr(xlErrValue)
End Function
Approach isolating the date string via Filter function
Just for fun another approach demonstrating the use of the Filter function in combination with Split to isolate the date string and split it into date tokens in a second step; finally these tokens are transformed to date using DateSerial:
Function getDat(rng As Range, Optional ByVal tmp = " ") As Variant
If rng.Cells.count > 1 Then Set rng = rng.Cells(1, 1) ' allow only one cell ranges
If Len(rng.value) = 0 Then getDat = vbNullString: Exit Function ' escape empty cells
' [1] analyze cell value; omitted year tokens default to current year
' (valid date strings must include at least one slash, "11/" would be interpreted as Nov 1st)
tmp = Filter(Split(rng.Value2, " "), Match:="/", include:=True) ' isolate Date string
tmp = Split(Join(tmp, "") & "/" & Year(Now), "/") ' split Date tokens
' [2] return date
Const M% = 0, D% = 1, Y& = 2 ' order of date tokens
getDat = VBA.DateSerial(Val(tmp(Y)), Val(tmp(M)), _
IIf(tmp(D) = vbNullString, 1, Val(tmp(D))))
End Function
Is there a way to override Now() in VBA for testing purposes? Something like this here - What's a good way to overwrite DateTime.Now during testing?, but for VBA.
Thus, I would need Now() to return a predefined value and not the current PC time.
What I do not want is something like this:
Option Explicit
Public Function NowDefined() As Date
'NowDefined = Now()
NowDefined = Format("2016-01-15 15:01:01", "yyyy-MM-dd hh:mm:ss")
End Function
and simply changing in the whole code Now() to NowDefined().
Rather than creating a String variable and then making Excel try to cast it to a Date, you would be better off generating the actual date to start with:
Function Now() As Date
Now = DateSerial(2016, 1, 15) + TimeSerial(15, 1, 2)
End Function
Vityata's answer works, but it is a bit fragile and can get cumbersome: you must remember to remove or comment out the entire function declaration when you're done testing; and put it back in whenever you need to do more testing... and then remember to remove it again when you release... etc.
I'd do something like this:
Const IN_TESTING_MODE As Boolean = True ' Set this to false when done testing
Function Now() As Date
If IN_TESTING_MODE Then
Now = ... 'whatever date you want
Else
Now = VBA.Now() ' back to default behavior
End If
End Function
Here you only have to change one thing to go in and out of testing mode: the value of the constant IN_TESTING_MODE. You can reuse this constant in other functions as well for which you want a different behavior while testing.
Actually this works:
Option Explicit
Public Function Now() As Date
Now = Format("2016-01-15 15:01:01", "yyyy-MM-dd hh:mm:ss")
End Function
At work I am required to reformat incorrect Addresses on a weekly basis from records in our Salesforce instance. We gather the incorrectly formatted addresses using a Report and export them to an Excel file. My job is simply to manipulate the data in the file to format them properly then reinsert them into the database.
Typically the addresses are formatted as so:
5 Sesame Street, Anytown, Anyplace
Separating these can be done easily by hand, but I typically have to work with hundreds of addresses at a time, and using default excel formulas tends to require lots of wrangling multiple cells at once to break it up into fragments.
Thus I wrote a custom formula to run through the cell and return a specific fragment of the string based on the "Comma Number" given. So if I give a Comma Number of 1, I would get "5 Sesame Street", 2 would get me "Anytown", etc.
Here is my code so far:
Public Function fragmentAddress(address As String, numberofcommas As Integer) As String
seen = 1
lastComma = -1
Dim x As Long
Dim frag As Long
For x = 0 To Len(address)
If Mid(address, x, 1) = "," & numberofcommas = seen Then
Exit For
ElseIf Mid(address, x, 1) = "," & numberofcommas <> seen Then
seen = seen + 1
lastComma = x
End If
Next
frag = Mid(address, lastComma + 1, seen - lastComma)
fragmentAddress = frag
I have not implemented the ability to handle the final value yet, but it does not give me any outputs, only outputting a "#VALUE!" error when I attempt to give it the input
=fragmentAddress("3 Ashley Close, Charlton Kings",1)
I have some experience with programming, but this is my first time writing anything in VBA.
Any help would be appreciated, thank you.
Not exactly sure what your question is, but this is simpler:
Public Function GetAddressFragment(ByVal Address As String, ByVal Index As Integer) As String
Dim addr() As String
addr = Split(Address, ",")
On Error Resume Next
GetAddressFragment = Trim(addr(Index - 1))
End Function
I have written a macro to take values from an external simulation tool and prints the results in excel.The simulaion tool will give values only every 30 seconds and will run for days. Hence i have given a delay in VB for 30 seconds in loop. I leave it overnight for running. In the next morning i could see none of the results were updated after certain rows.But the VBA editor header shows the macro is running and the external simulation tool is also running. The last updated row in excel is not constant everytime. Why does VBA stops printing the results in excel? Any help will be much appreciated.
Sample code:
For l = 3 To lastrow1_mul + 2
Module4.Wait 30
nv = send_data.Call
Sheets(SecondSheetName).Range(SecondSheetCol_9 & l) = Hex(nv)
dv = DT.Call
If dv = 44 Then
Sheets(SecondSheetName).Range(SecondSheetCol_10 & l) = "A"
ElseIf dv = 54 Then
Sheets(SecondSheetName).Range(SecondSheetCol_10 & l) = "B"
Else
Sheets(SecondSheetName).Range(SecondSheetCol_10 & l) = "C"
End If
Next l
Module 4:
Function Wait(PauseTime As Single)
Dim StartTime As Single
StartTime = Timer
While Timer < StartTime + PauseTime
DoEvents
Wend
End Function
Send_data and DT are external simulation tool's functions.Variable lastrow1_mul's value is getting updated around 7000 but rows in excel stops printing around 500 itself(not constant always) .
looks OK but look at using Application.OnTime shown below. Also what happens if the simulation hasnt returned data, shoudnt you build in a bigger, maybe 45 second intervals?
Application.OnTime Now + TimeValue("00:00:30"), "RunProcess"
The 'Timer' i used in the code was the culprit. Timer counts the seconds elapsed(in fractions) since midnight. So it will not update when the time becomes 00.00.00. So the wait function i wrote will keep on waiting!
Here is the solution
Function Wait()
Dim StartSecond As Single
Dim EndSecond
StartSecond = Now
EndSecond = DateAdd("s", 30, Now)
While Now < EndSecond
DoEvents
Wend
End Function