I have written a program which calculates the time difference between two times.
It calculates the time difference between upto some extent (or few cells appropriately). After few cells it writes garbage values to the rest of the cells.
Please help me.
See the code below.
Sub Average()
Dim LogIn As String
Dim LogOff As String
Dim Row As Integer
Dim Col As Integer
Dim InTime As Date
Dim OffTime As Date
Row = 1
Col = 2
While (Cells(Row, Col) <> "")
Workbooks("Log-In-Time.xlsm").Activate
InTime = Cells(Row, Col)
Workbooks("Log-Off-Time.xlsm").Activate
OffTime = Cells(Row, Col)
Workbooks("Log-In-Time.xlsm").Activate
Cells(Row, Col + 1) = CDate(OffTime) - CDate(InTime)'<- Without CDate also I have tried but output was same.
Row = Row + 1
Wend
End Sub
My Log-In-Time.xls content is,
OUTPUT
7/11/2013 11:35:41 AM 7:14:15 AM
7/15/2013 11:05:22 AM 10:03:00 AM
7/16/2013 9:58:25 AM 11:11:31 AM
7/17/2013 10:33:20 AM 10:39:25 AM
7/18/2013 11:10:33 AM 6:58:35 AM
7/19/2013 12:18:59 AM 7:18:09 PM <-----Here onwadrs
7/22/2013 11:58:26 AM 0.370185185
7/23/2013 11:27:14 AM 0.418645833
7/24/2013 10:59:36 AM 0.439953704
7/25/2013 11:20:16 AM 0.382650463
7/26/2013 11:09:14 AM 0.373171296
Log-Off-Time.xls contents are,
7/11/2013 6:49:56 PM
7/15/2013 9:08:22 PM
7/16/2013 9:09:56 PM
7/17/2013 9:12:45 PM
7/18/2013 6:09:08 PM
7/19/2013 7:37:08 PM
7/22/2013 8:51:30 PM
7/23/2013 9:30:05 PM
7/24/2013 9:33:08 PM
7/25/2013 8:31:17 PM
7/26/2013 8:06:36 PM
Finally got the answer...
Just added the code below.
Dim Diff As Date
Diff = CDate(OffTime) - CDate(InTime)
Find the complete code below.
Sub Average()
Dim LogIn As String
Dim LogOff As String
Dim Diff As Date
Dim Row As Integer
Dim Col As Integer
Dim InTime As Date
Dim OffTime As Date
Row = 1
Col = 2
While (Cells(Row, Col) <> "")
Workbooks("Log-In-Time.xlsm").Activate
InTime = Cells(Row, Col)
Workbooks("Log-Off-Time.xlsm").Activate
OffTime = Cells(Row, Col)
Workbooks("Log-In-Time.xlsm").Activate
Diff = CDate(OffTime) - CDate(InTime)
Cells(Row, Col + 1) = Diff
Row = Row + 1
Wend
End Sub
Related
How do i convert day/Month to Julian Day in visual basic?
Formula for converting in other languages are also appreciated.
For e.g
Julian Day for 1 Feb=032
https://landweb.modaps.eosdis.nasa.gov/browse/calendar.html
From research in the web ,most resolutions are converting the date with yyyy-mm-dd to julian date.
As the example above, i need to get value 032
The .Net JulianCalendar Class exposes all methods needed to achieve your goal. It is also COM visible, so you can reference it in a VBA project after adding a project reference to "mscorlib.dll".
In VB.Net the code would be:
Dim jc As New System.Globalization.JulianCalendar
' create a gregorian equivalent of the julian date: 1 Feb 2018
Dim gregoriaDateEquivalent As DateTime = jc.ToDateTime(2018, 2, 1, 0, 0, 0, 0)
' = #2/14/2018 12:00:00 AM#
Dim dayOfYear As Int32 = jc.GetDayOfYear(gregoriaDateEquivalent)
' = 32
In VBA the code would be:
Dim jc As mscorlib.JulianCalendar
Set jc = New mscorlib.JulianCalendar
' create a gregorian equivalent of the julian date: 1 Feb 2018
Dim gregoriaDateEquivalent As Date
gregoriaDateEquivalent = jc.ToDateTime(2018, 2, 1, 0, 0, 0, 0)
' = #2/14/2018
Dim dayOfYear As Long
dayOfYear = jc.GetDayOfYear(gregoriaDateEquivalent)
' = 32
First you have to add reference to mscorlib library
Under VB6,Project-References->Tick the mscorlib checkbox
Create this function method in the object that you ahve or otherwise create a sub procedure
Public Function JulianConverter() As String
'MsgBox Fix(5.2), vbExclamation, App.Title
'MsgBox Fix(5.6)
Dim y As String
Dim m As String
Dim d As String
Dim strDate As String
Dim dateArray() As String
strDate = Format(Now, "dd/MMM/yyyy")
dateArray = Split(strDate, "/")
d = dateArray(0)
m = dateArray(1)
y = dateArray(2)
'Debug
'MsgBox strDate
'Convert to Integer
y = Val(y)
m = Val(m)
d = Val(d)
If m <= 2 Then
y = y - 1
m = m + 12
End If
'Dim A As Double
' Dim B As Double
'Dim JD As Double
' A = CDbl(Fix(y / 100#))
'B = 2 - A + Fix(A / 4)
'JD = Fix(365.25 * (y + 4716)) + Fix(30.6001 * (m + 1)) + d + B - 1524.5
'JulianConverter = CStr(JD) 'Convert to string
Dim jc As mscorlib.JulianCalendar
Set jc = New mscorlib.JulianCalendar
' create a gregorian equivalent of the julian date: 1 Feb 2018
Dim gregoriaDateEquivalent As Date
gregoriaDateEquivalent = jc.ToDateTime(2018, m, d, 0, 0, 0, 0)
' = #2/14/2018
Dim dayOfYear As Long
Dim dayOfYearS As String
Dim digitLength As Integer
Dim Counter As Integer
dayOfYear = jc.GetDayOfYear(gregoriaDateEquivalent)
'Have to ensure 3 digits values
dayOfYearS = CStr(dayOfYear)
'Count number of Digits of string
digitLength = Len(dayOfYearS)
MsgBox "DigitLength" & digitLength, vbExclamation, App.Title
'If Digits length smaller than 3,add one 0 in front
If (digitLength < 3) Then
dayOfYearS = "0" & dayOfYearS
End If
JulianConverter = dayOfYearS
End Function
This will ensure the julian day will be 3 digits in value based on the current system date
All,
I have written a little procedure which I would like a for each loop to insert the current month into the first cell "01"/MM/YY and then add one month to the date as it goes through the loop. Using the example below;
K1 = 01/06/2018
L1 = 01/07/2018
M1 = 01/08/2018 etc
The code I am using is below - The error is on the DateAdd line.
Sub test()
Dim dt As date
dt = "01/" & Application.Text(Now(), "MM/YY")
Dim i As Double
i = 1
For Each c In Range("K1:XFD1")
If c.Value = "" Then Exit For
c.Value = dt
'change date to one months time
dt = DateAdd(m, i, dt)
i = i + 1
Next c
End Sub
Any help regarding this would be much appreciated.
Put "m" not m. m would be a variable. "m" is a literal string representing the argument being "month".
dt = DateAdd("m", i, dt)
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.
I have three cells IN , OUT& OverTime all formatted as [h]:mm,
The OT cell has this forumla,
=ROUND(IF(((D10-C10)+(D11-C11))*24>7,((D10-C10)+(D11-C11))*24-7,0)/24*96,0)/96
that calculates OT to the 1/4 hr
8 C D E F
9 IN OUT O/T C/T
10 7:30 AM 12:15 PM 1:45
11 1:00 PM 5:00 PM
When the employee clockes out for the day, I would like the following
code to run;
Dim CT As Date
Title = "Add to CompTime from OverTime"
If Range("E10") > 0 Then
CT = InputBox("Add Hours to CompTime?", Title)
If CT > 0 Then Range("F10").Value = ("E10" - CT)
Else: Range("F10").Value = " "
End If
End Sub
Everthing seems to work except;
If CT > 0 Then Range("F10").Value = ("E10" - CT)
I know it is a formatting issue but I am unable resolve the issue.
Always try to do the explicit referencing to ranges whether they are on sheets or modules. Use proper properties of the objects - in your case you have a range E10 which is not qualified. Assuming you are working in Sheet 1:
Option Explicit
'--Beginning of your Subroutine...
Dim Title as String '-- assuming
Dim CT As Date '-- are you sure you want to have a date here?
Title = "Add to CompTime from OverTime"
If Sheets(1).Range("E10").Value > 0 Then '-- assuming it's a valid date here...
CT = InputBox("Add Hours to CompTime?", Title)
'-- assume your CT = 2:45 and OT = 75:30
'-- use the following as mentioned in my comment
If CT > 0 Then
Application.Text( Sheets(1).Range("F10").Value ,"[h]:mm") =
Application.Text(Sheets(1).Range("E10").Value, "[h]:mm") - Application.Text(CT, "[h]:mm")
Else
Sheets(1).Range("F10").Value = " "
End If
End If
End Sub
PS: If you are trying to calculate hours, you may have just use VBA to do the entire calculations.. =)