I have infinite rows with with a single column assigned to define date and time in the following 'General Format' "2016.08.10 06:00:00.066". I am aware that you can't convert every single cell in this column "mm/dd/yyyy hh:mm:ss.000 AM/PM". Therefore I would a single column assigned to "mm/dd/yyyy" and another column assigned to "hh:mm:ss.000 AM/PM". The time is currently 6 hours behind as well so I would like to add 6 hours to it.
I am struggling with this as although the cells are in general or text format the time and date is being displayed as "yyyy.mm.dd hh:mm:ss.000". And can't find a way to split the two in this format
Any help is appreciated
To convert the text to a format that Excel will change to a data/time use this:
=--SUBSTITUTE(SUBSTITUTE(A1,".","/",1),".","/",1)
Then to add 6 hours you would use:
+ TIME(6,0,0)
So to get the date/time is:
=--SUBSTITUTE(SUBSTITUTE(A1,".","/",1),".","/",1) + TIME(6,0,0)
Then simply format the new cell:
mm/dd/yyyy hh:mm:ss.000 AM/PM
You can also split it into the date and time:
Date:
=INT(--SUBSTITUTE(SUBSTITUTE(A1,".","/",1),".","/",1) + TIME(6,0,0))
And format it mm/dd/yyyy
Time:
=MOD(--SUBSTITUTE(SUBSTITUTE(A1,".","/",1),".","/",1) + TIME(6,0,0)),1)
And format it hh:mm:ss.000 AM/PM
use text: =concatenate(text(a1,"MM"),text(a1,"DD"),text(a1,"YYYY") do the same for the other column =concatenate(text(a1,"HH"),text(a1,"MM"),text(a1,"SS")
That's pretty strange that you Excel will round off the milliseconds if you try and use a Date-Time format.
Enum DTValues
ReturnDate
ReturnTime
ReturnDateTime
End Enum
Function getDateTime(yyyymmdd_hh_mm_ss_000 As String, ReturnValue As DTValues) As Single
Dim arr
Dim mSecs As Single
yyyymmdd_hh_mm_ss_000 = Replace(yyyymmdd_hh_mm_ss_000, " ", ".")
yyyymmdd_hh_mm_ss_000 = Replace(yyyymmdd_hh_mm_ss_000, ":", ".")
arr = Split(yyyymmdd_hh_mm_ss_000, ".")
mSecs = arr(6) / 24 / 60 / 60 / 100
Select Case ReturnValue
Case ReturnDate
getDateTime = CSng(DateSerial(arr(0), arr(1), arr(2)))
Case ReturnTime
getDateTime = CSng(TimeSerial(arr(3), arr(4), arr(5))) + mSecs
Case ReturnDateTime
getDateTime = CSng(DateSerial(arr(0), arr(1), arr(2))) + CSng(TimeSerial(arr(3), arr(4), arr(5))) + mSecs
End Select
End Function
Sub ProcessDates()
Const WORKSHEET_NAME = "Sheet1"
Const FIRST_ROW = 2
Const SOURE_COLUMN = 1
Const DATE_COLUMN = 2
Const TIME_COLUMN = 3
Dim Target As Range
Dim arDate, arTime
Dim y As Long
With Worksheets(WORKSHEET_NAME)
Set Target = .Range(.Cells(FIRST_ROW, SOURE_COLUMN), .Cells(Rows.Count, SOURE_COLUMN).End(xlUp))
End With
arDate = Target.Value
arTime = Target.Value
For y = 1 To UBound(arDate)
arDate(y) = getDateTime(arDate(y), ReturnDate)
arTime(y) = getDateTime(arTime(y), ReturnTime)
Next
Target.EntireRow.Columns(DATE_COLUMN).Value = arDate
Target.EntireRow.Columns(TIME_COLUMN).Value = arTime
End Sub
Related
I have 2 tables, Table 1 and Table 2. Both the tables have one date column each. I am inserting the first Monday of the month on top of the table 1 and Table 2, both. I will fetch date value from each row of the table 2, and if it is more than the value on top of the table, I will insert 0. If the date value in the table 2 is "16/02/2018", and it is not a Monday, I will insert the Monday after it, and the value 1 for that record.How can I proceed with it? Please help.
Dim col_tab2_dat as Date
first_day = DateSerial(Year(Date), Month(Date), 1)
last_day = DateSerial(Year(Date), Month(Date) + 1, 1)
curr_month= Format(first_day, "mmm")
w = Weekday(first_day , vbMonday)
FirstMonday = first_day + IIf(w <> 1, 8 - w, 0)
tab1_last_lin = ws.Columns(2).Find("Total(T1)").Row
tab2_last_lin = ws.Columns(2).Find("Total(T2)").Row
find_tab2 = ws.Columns(1).Find("Table 2").Row
last_lin = Range("B" & Rows.Count).End(xlUp).Row
last_col_tab1 = ws.Cells(tab1_last_lin, ws.Columns.Count).End(xlToLeft).Column
last_col_tab2 = ws.Cells(tab2_last_lin, ws.Columns.Count).End(xlToLeft).Column
last_dat = ws.Cells(2, last_col_tab1 - 1).Value
new_date = last_dat + 7
For i = find_tab2 + 3 to tab2_last_lin
ws.Cells(find_tab2 + 3, 1).Value = col_tab2_dat
If col_tab2_dat > last_dat Then
I am stuck here. What to do next?
End If
Next i
Here is a function that will return the next Monday:
Public Function GetNextMonday(dt As Date) As Date
Do Until Weekday(dt, vbSunday) = 2
dt = DateAdd("d", 1, dt)
Loop
GetNextMonday = dt
End Function
Here's a function that will work for any day of the week.
NextWeekday Function:
Function NextWeekday(FromDate As Date, vbWeekday As VbDayOfWeek) As Date
If Weekday(FromDate) < vbWeekday Then
NextWeekday = FromDate + vbWeekday - Weekday(FromDate)
Else
NextWeekday = FromDate + 7 + vbWeekday - Weekday(FromDate)
End If
End Function
It takes two arguments:
FromDate: The Date of which you are wanting to find the next weekday of. You can simply use "Date" as the argument for today's Date.
vbWeekday: The upcoming day of the week you are wanting the date for.
VBA Example:
Once you've added the above function to your code module, it's easy to get its value:
Sub Main()
Dim NextThursday As Date
NextThursday = NextWeekday(Date, vbThursday)
End Sub
Worksheet Formula Example:
Or you can use it as a worksheet function:
=NextWeekday(Today(), 5)
Worksheet Formula Considerations:
Notice in the worksheet formula we had to remove the vbThursday constant as worksheet functions doesn't have this functionality built-in. However, if you want to still use these constant values in your worksheet, you can create them yourself by using the Name Manager.
Click on the Formulas Tab, then on Define Name
Start creating your constants starting at vbSunday = 1 through vbSaturday = 7 by placing the Constant Name in the Name: field, and the value in the Refers to: field:
And there you have it! You can now refer to them using your named values:
Additional Example Usage:
Comments:
The benefit of using the VbDayOfWeek Type is that you will now gain IntelliSense when using the function:
I want to calculate the difference in hh:mm:ss between Now and column E. They both appear in format dd/mm/yyyy hh:mm. With the code I have written below, it only takes into consideration the hh:mm and not the days. So, if they have 2 days difference in wont add to the hours +48. The code is below:
With ws1.Range("N2:N" & lastrow1)
.Formula = "=TIME(HOUR(NOW()),MINUTE(NOW()),SECOND(NOW()))-TIME(HOUR(E2),MINUTE(E2),SECOND(32))"
End With
Just use =(NOW()-E2) and apply a custom format [hh]:mm:ss. The brackets around hh will do the trick.
If you rather need a number of hours, multiply by 24 as #Kerry Jackson suggested.
The logic behing date/time values is that 1 day = 1, so
1 hour = 1/24
1 min = 1/1440 '(that is 24*60 )
etc...
Put this in a module
Public Function DateTimeDiff(d1 As Date, d2 As Date)
Dim diff As Double
diff = ABS(d2 - d1)
DateTimeDiff = Fix(diff) & Format(diff, " hh:mm")
End Function
Then use
=DateTimeDiff( NOW(), E2 )
as the formula in the worksheet.
You might want to add some validation on the dates and return an error message if they are not valid.
Are you looking for a number which is the number of hours, or are you looking for text?
If you want the number of hours, try just subtracting the dates, and multiplying by 24, so the formula would be =(NOW()-E2)*24.
Public Function timeElapsed(ByVal target_cell As Range) As String
Dim hours As Long, minutes As Long, days As Long
If target_cell.Value = 0 Then Exit Function
x = DateDiff("n", target_cell, Now())
days = Format(Application.WorksheetFunction.RoundDown(x / 1440, 0), "00")
hours = Format(Application.WorksheetFunction.RoundDown((x - (days * 1440)) / 60, 0), "00")
minutes = Format(Application.WorksheetFunction.RoundDown((x - ((days * 1440) + (hours * 60))), 0), "00")
timeElapsed = CStr(days) & " " & "days" & " " & CStr(hours) & ":" & CStr(minutes)
End Function
And use as function with the result as below:
So you code becomes:
With ws1
.Range("N2:N" & lastrow1).FormulaR1C1 = "=timeElapsed(RC[-9])"
End With
Working on populating a row in excel with dates between a start date and current date. The population is weekly and below is the function I have made. It works fine up until the point where it doesn't stop but continues to go infinitely until there is an overflow error hence my assumption is that CurrentDate is not working properly.
The 2 dates used are StartDate = 04/1/2016 and CurrentDate = 12/07/2017.
Any help or suggestions would be greatly appreciated.
Public Function PopulateStartOfWeekDates()
Dim wsCRC As Worksheet
Set wsCRC = Worksheets("CRC")
Dim StartDate As Date
Dim CurrentDate As Date
StartDate = FirstMondayOfYear()
CurrentDate = Date
Dim WeekOffset As Integer
Dim i As Integer
i = 12
WeekOffset = 0
Debug.Print StartDate
Debug.Print CurrentDate
Do While StartDate < CurrentDate
wsCRC.Cells(5, i) = StartDate + WeekOffset
wsCRC.Cells(5, i).EntireColumn.AutoFit
i = i + 1
WeekOffset = WeekOffset + 7
Loop
End Function
If you decide you need to maintain the value of StartDate (e.g. to use later in the code), you could replace your loop with:
i = 0
Do While StartDate + i * 7 < CurrentDate
wsCRC.Cells(5, i + 12) = StartDate + i * 7
wsCRC.Cells(5, i + 12).EntireColumn.AutoFit
i = i + 1
Loop
After looking at this myself I realized I wasn't increasing the startdate hence the loop was infinite. Thanks to #Nathan_Sav for pointing this out in the comments too.
I am trying to keep the date of some event occurrence. I am having trouble with the way my data has been defined. Instead of showing the actual date the output is showing in 1900 format (like 10/1/1900)
Here is my code:
Dim Arr_rate As Date
Dim D(528) As Date
for i = 3 to 500
Arr_rate = -3.7 * Log(Rnd) '<~~ Arrival interval
D(2) = CDate(1 / 1 / 2006)
D(i) = D(i - 1) + Arr_rate
Worksheets("A").Cells(i, "E").Value = Cdate(D(i))
next i
I tried to have the sdate format in my code but it will not give me the numbers in a proper format (1/1/2006). How can I print in the proper format? I have read some post in stackover flow but was not helpful!
Without quotes 1\1\12006 is just a mathematical expression and not a date.
Sub test()
Dim Arr_rate As Date
Dim D(528) As Date
For i = 3 To 500
Arr_rate = -3.7 * Log(Rnd) '<~~ Arrival interval
'<~~ Using Cdate, then use string. Otherwise 1 / 1 / 2006 evaluates to 4.98504486540379E-04
D(2) = CDate("1 / 1 / 2006")
D(i) = D(i - 1) + Arr_rate
Worksheets("Sheet1").Cells(i, "E").Value = CDate(D(i))
Next i
End Sub
If i have a string containing a date formatted like this:
1402-3
which means Year: 2014, Week: 02 and Day number 3 (monday is 1), how can i convert this to a normal date? (in this case the date above is today; 2014-01-08 - wednesday 8 jan 2014)
Edit: I came up with a function like this, can anyone tell if this is gonna fail or maybe have a better and better coded function/solution?
Private Function StrangeFormattedDateToRegularDate(ByVal StrangeDate As String) As Date
Dim Y As String = "20" & StrangeDate.Substring(0, 2) 'I'll be dead before this fails, haters gonna hate
Dim W As String = StrangeDate.Substring(2, 2)
Dim D As String = StrangeDate.Substring(5, 1)
'Get first day of this year
Dim RefDate As Date = New Date(CInt(Y), 1, 1)
'Get the first day of this week (can be the year before)
Dim daysOffSet As Integer = DayOfWeek.Monday - RefDate.DayOfWeek
RefDate = RefDate.AddDays(daysOffSet)
'Add as many days as the weeks is
RefDate = RefDate.AddDays(7 * CInt(W))
'now the date is the last day of this week (plus one day), remove the days that are ahead, and remove that extra day
Dim daysToRemove = ((7 - CInt(D)) * -1) - 1
RefDate = RefDate.AddDays(daysToRemove)
Return RefDate
End Function
This should be what you're looking for :) This looked challenging so I tried it. Tell me if it works for you or not :)
Function GetDate(InputDate As String) As DateTime
Dim FirstDayofYear As Date = CType("1/1/20" & Mid(InputDate, 1, 2), Date)
Dim LastDayofYear As Date = CType("12/31/20" & Mid(InputDate, 1, 2), Date)
Dim target As Date
For x = 0 To DateDiff(DateInterval.Day, FirstDayofYear, LastDayofYear)
Dim dfi = DateTimeFormatInfo.CurrentInfo
Dim calendar = dfi.Calendar
Dim weekOfyear = calendar.GetWeekOfYear(FirstDayofYear.AddDays(x), dfi.CalendarWeekRule, DayOfWeek.Sunday)
If CInt(Mid(InputDate, 3, 2)) = weekOfyear And CInt(Mid(InputDate, InStr(InputDate, "-") + 1)) = FirstDayofYear.AddDays(x).DayOfWeek Then
target = FirstDayofYear.AddDays(x)
GoTo skip
End If
Next x
skip:
Return target
End Function
This works up to Year 2099. We're probably all dead by then.