As I need to log my working hours for project reasons I am trying to configure a macro. As I am rather new to VBA I am still experiencing difficulties with code formulas and time-formats.
Here is how the sheet looks like
When pressing "ARRIVAL" or "DEPARTURE" it's just Range("C7/C9") = Now
(this is in seperate cells because I want to be able to manually override)
When pressing "LOG" this is the code behind it:
'FORMAT
Range("12:12").Insert
Range("C7").Copy
Range("C12:I12").PasteSpecial
Range("C12:I12").ClearContents
'DATE
Range("C7").Copy
Range("C12").PasteSpecial
Range("C12").NumberFormat = "m/d/yyyy"
'ARRIVAL
Range("C7").Copy
Range("D12").PasteSpecial
Range("D12").NumberFormat = "[$-F400]h:mm:ss AM/PM"
'DEPARTURE
Range("C9").Copy
Range("E12").PasteSpecial
Range("E12").NumberFormat = "[$-F400]h:mm:ss AM/PM"
'CALCULATE
Range("E12").Copy
Range("F12").PasteSpecial
Range("F12") = Range("E12").Value - Range("D12").Value
Range("C12:I12").Font.Size = 12
What I want now is in column G the amount of time I have been working on project which is less then 03:30h and in column H the amount of time I have been working on project which is more then 03:30h.
Ideally this would be in #Minutes and even combined in 1 column with a (+/-) so I can easily calculate the totals.
Thanks for looking into this!
I've updated your code a bit and included some notes to explain why. I've added the 2 formulas that convert your total time into minutes and calculate the differences for the < & > requirements. Hope this helps.
Sub LogTime()
Range("12:12").Insert
Range("C7").Copy
'Pastes just the format from C7
Range("C12:I12").PasteSpecial (xlPasteFormats)
'Set as Today's Date
Range("C12").Value = Date
'Arrival
Range("D12").Value = Range("C7").Value
Range("D12").NumberFormat = "[$-F400]h:mm:ss AM/PM"
'Departure
Range("E12").Value = Range("C9").Value
Range("E12").NumberFormat = "[$-F400]h:mm:ss AM/PM"
'Calculate Total with Formula
Range("F12").Value = "=" & Range("E12").Address(0, 0) & "-" & Range("D12").Address(0, 0)
Range("C12:I12").Font.Size = 12
'Convert Time To Minues: (HOUR(F12)*60)+MINUTE(F12)+ROUND((SECOND(F12)/60),0)
'< Formula: In Minutes; if Total Time is => 3:30 return 210 and Total Time if < 3:30 return Total Time
Range("G12").Value = "=IF(((HOUR(F12)*60)+MINUTE(F12)+ROUND((SECOND(F12)/60),0))>=210,210,(HOUR(F12)*60)+MINUTE(F12)+ROUND((SECOND(F12)/60),0))"
Range("G12").NumberFormat = "General"
'< Formula: In Minutes; if Total Time is <= 3:30 return 0 and if Total Time > 3:30 return total time - 3:30
Range("H12").Value = "=IF(((HOUR(F12)*60)+MINUTE(F12)+ROUND((SECOND(F12)/60),0))<=210,0,((HOUR(F12)*60)+MINUTE(F12)+ROUND((SECOND(F12)/60),0)-210))"
Range("H12").NumberFormat = "General"
End Sub
Related
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
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
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
I have a button_click macro that is to run a lengthy set of VBA code to create and/or update a daily report based on the date entered in an input box, a monthly report sheet with just the daily totals, and an unmatched report sheet for the UIDs that do not match between the two sheets containing the original data. For most dates this works as it should. However, when the date "7/11/2014" is entered in numeric format it pulls all of the dates from 7/11/2014 to the end of the available dates in both sheets. However, if I enter the date as "July 11,2014" the script runs as it should.
Is there a reason WHY 7/11/2014 (7/11, or 7/11/14) would pull in data from 7/11/14 forward, rather than just data specifically related to 7/11/14? My code is very lengthy and I'm not sure if it is an Excel issue with dates or if I have an issue in my code, and if so where.
I can share code if necessary but as I said, I'm not sure where the issue is located.
Thanks,
TSC
Original code
' if the requested date exists in wksKEY column A, then proceed.
If dtExists(sKeyDate, wksKEY, "A:A") Then
' nFDtRow = the first row in wksKEY with the requested date, which is stored in
' wksGDR A5 using Keystone_Data date format of YYYYMMDD
nFDtRow = MatchUID(wksGDR, wksKEY, "A5", "A1:A" & lKeyLastRow)
' nLDtRow = last row in wksKEY with specified date; stored in wksGDR A6 as YYYYMMDD
nLDtRow = MatchUID(wksGDR, wksKEY, "A6", "A1:A" & lKeyLastRow) - 1
' if the last date row is less than the first date row, then...
If nLDtRow < nFDtRow Then
' wksGDR A6 = the date in A5 + 2 (i.e. if 20140102 is the date selected and 20140103
' is not in wksKEY, then wksGDR A6 = 20140104)
wksGDR.Range("A6").Value = wksGDR.Range("A5").Value + 2
' if there is not a match in wksKEY for the value in wksGDR A6, IsError will equal True.
' if there is not an error, hence the match search = True, then ...
If Not MatchUID(wksGDR, wksKEY, "A6", "A1:A" & lKeyLastRow) = 0 Then
' nLDtRow = the first row with the value in wksGDR A6 - 1 to equal the last row with the
' desired date
nLDtRow = MatchUID(wksGDR, wksKEY, "A6", "A1:A" & lKeyLastRow) - 1
Else
' Otherwise, if there is an error, nLDtRow equals the last row in wksKEY
nLDtRow = lKeyLastRow
End If
End If
' nCtDtRow = the total count of matching date rows in wksKEY
nCtDtRow = (nLDtRow - nFDtRow) + 1
' review each row with i doing the count and j representing the actual row number
For i = 1 To nCtDtRow
' lDRNewRow = the row number where a new row can be added
lDRNewRow = lDRRowEnd + i
' j = the first date row # + i (counting from 1 to the total #) - 1 to get the proper
' row #
j = nFDtRow + (i - 1)
' If current UID does not already exist in a Daily_Report or the Unmatched_Report, then...
If StopDupeUIDs(wksKEY, "AM" & j, lKeyLastRow) = True Then
' Verify that there is no match between the current UID and one already in wksDR
If MatchUID(wksKEY, wksDR, "AM" & j, "P3:P" & lDRRowEnd) = "0" Then
' enter wksKEY UID into wksDR column P
wksDR.Range("P" & lDRNewRow).Value = wksKEY.Range("AM" & j)
End If
Else
' Otherwise, if the requested UID already exists in another sheet, update column R and color it bright green
If UpdateUID(wksKEY, "AM" & j, lKeyLastRow) <> "" Then
wksGDR.Range("A7").Value = UpdateUID(wksKEY, "AM" & j, lKeyLastRow)
sTempWS = Left(wksGDR.Range("A7").Value, InStr(1, wksGDR.Range("A7"), Chr(124), vbTextCompare) - 1)
lTempCell = Right(wksGDR.Range("A7").Value, Len(wksGDR.Range("A7")) - InStr(1, wksGDR.Range("A7"), Chr(124), vbTextCompare))
Worksheets(sTempWS).Range("R" & lTempCell).Value = j
Worksheets(sTempWS).Range("R" & lTempCell).Interior.Color = RGB(0, 255, 0)
Call ckQty(Worksheets(sTempWS), lTempCell, lTempCell)
End If
wksGDR.Range("A7").Value = ""
End If
Next i
Else
' otherwise, if the requested date does not exist in wksKEY column A, exit this subroutine.
Exit Sub
End If
To correct the issue, and hopefully make it more versatile, I removed the 'If nLDtRow < nfDtRow Then...' statement and replaced it with
' wksGDR A6 = the number of times sKeyDate exists within wksKEY column A
wksGDR.Range("A6").Value = WorksheetFunction.CountIf(wksKEY.Range("A1:A" & lKeyLastRow), sKeyDate)
' wksGDR A7 = nFDtRow + wksGDR A6
wksGDR.Range("A7").Value = nFDtRow + wksGDR.Range("A6").Value
' nLDtRow = wksGDR A7
nLDtRow = wksGDR.Range("A7").Value
I also updated nCtDtRow to nCtDtRow = wksGDR.Range("A6").Value rather than trying to recalculate it.
I've been learning VBA (it has been more than a decade since I took VB in school or really used it for anything) as I've gone along with this project.
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.. =)