Excel modify date & time - vba

In the VBA script, I need to modify the date & time. i.e. Increment or decrement the day, set time to 8am or 8 pm depending on the conditions.
I have here the relevant code segment -
Variable declared -
' To reference the cell having the source date
Dim d As String
' To reference the cell where the modified date is written
Dim destCell As String
' Some cell that contains 1 or 0
Dim somecell As String
'If condition and value assignment
If Range(somecell).Value = 1 Then
Range(destCell).Value = DATE(YEAR(Range(d)),MONTH(Range(d)),DAY(Range(d)-1))+TIME(8,0,0)
Question:
What I have done is to decrement the day and set the time to 8am, when the condition is satisfied. I get a syntax error. Please help.

You need to replace DATE with DateSerial and TIME with TimeSerial:
Dim datSource As Date
datSource = Range(d).Value
If Range(somecell).Value = 1 Then
Range(destCell).Value = _
DateSerial(Year(datSource), Month(datSource), Day(datSource) - 1) + _
TimeSerial(8, 0, 0)

Related

Using VBA DateDiff to compare multiple Dates, output the difference and then compare output against another cell

I've got a spreadsheet which is used to record multiple times/dates where services were rendered.
In the spreadsheet the columns I'm interested in comparing start at row 9, column BA-BB, BC-BD, BE-BF, BG-BH, BI-BJ, BK-BL, BM-BN, BO-BP, BQ-BR for each of the rows in minutes. I then want to add all the total differences between the dates and finally compare that total with with AF9 if populated or if that cell is blank AG9.
I want the Macro to loop through all the rows producing a total units for each row at the end of the sheet (Column BU)
The purpose of the spreadsheet is to check that the value populated in either AF or AG is in fact correct if we were to work out the difference in times and convert to units anyway.
What I've been working on so far is:
Sub CalculateDate()
Dim Result, RowNo As Long
Dim FirstDate, SecondDate As Date
Dim ws As Worksheet
Set DateCompare = ActiveWorkbook.Sheets("Master")
Set DateCompareRng = Support.Range("BA2", Support.Cells(Rows.Count, "BA").End(xlUp).Offset(0, 18))
Set DateCompareArr = DateCompareRng.Value2
RowNo = 1
Do Until DateCompare.Cells(RowNo, 1) = ""
FirstDate = DateCompare.Cells(RowNo, 1)
SecondDate = DateCompare.Cells(RowNo, 2)
DateCompareArr(FirstDate, 3) = DateDiff("m", FirstDate, SecondDate)
RowNo = RowNo + 1
Loop
End Sub
The above is my shoddy attempt at amending some logic someone else provided on the forums to a similar question. I don't want to compare specific dates I enter though as the dates will all be different throughout the cells.
I've never used this type of function before in VBA so not really sure on how to go about changing it to suit my needs. If I can manage to loop through of of the start/end times I can probably work out how to loop through additional columns and compare against another 2 columns after that.
Some sample date is:
Start 1 | Start 2
23/03/2018 12:00 | 2018-03-23 16:00 GMT
Difference = (In minutes)
Compare Difference to:
Total Units(Column AF) = 600(this is 600 minutes)
Sorry that this is such a long question. I'm just really stuck with getting started on this problem
I like your attempt, you are on the right track. Below is tested sample code, which I think will provide you with the answer you're seeking. Good luck and happy coding
Public Sub CalculateDate()
'While I don't recommend hard coding the start and end of your range
'for this example, I thought it would simplify things.
'Start of the range is the first cell, which in your example seems
'like BA9
Const RANGE_START As String = "BA9"
'End of the range is the last cell in right most column, which
'in your example was BR. I chose the 18th row, but you could
'make it whatever you need
Const RANGE_END As String = "BR18"
'Declare a worksheet variable as you've done
'And set it to the worksheet in the ActiveWorkbook as you've done
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Master")
'Declare the range that contains the values you need to sum
Dim rngToSum As Range
'And set it to the range in the WorkSheet
'In this case the range will be
'ws.Range("BA9:BR18")
Set rngToSum = ws.Range(RANGE_START & ":" & RANGE_END)
'Declare an index to be used in the for loop below
'as we loop through each column in the row the
'code is summing
Dim nDx As Integer
'Declare a range for the row to be worked on
Dim rngRow As Range
'Declare a string value that will hold the
'output range(row, cell)
Dim outStr As String
'Declare an output range variable
Dim outRng As Range
'Declare a variable to hold the summation of the
'row values you want to add together
Dim rowSum As Long
'Outter loop to loop through each of the rows in the
'defined range
For Each rngRow In rngToSum.Rows
'Initialize/Reinitialize the rowSum to 0 for each row
rowSum = 0
'Inner loop to loop throug all the columns in the range
'you want to add together
For nDx = 1 To rngToSum.Columns.Count Step 2
'NOTE--> DateDiff uses lower case N for minutes, not lower case M
'I noticed that in your sample code
rowSum = rowSum + DateDiff("n", rngRow.Value2(1, nDx), rngRow.Value2(1, nDx + 1))
Next
'Completed adding all the columns together
'Assign the outPut row, cell for the output Range
'The formula below will concatenate the
'letter A with the current row number
'For example if the current row number is 9
'outStr will equal A9
outStr = "A" & rngRow.Row
'I always use Value2 since it is faster than the
'Text or Value properties of the range object
ws.Range(outStr).Value2 = rowSum
Next
End Sub

Excel VBA - Highlight cell if time is greater than 24 hours ago

I have a report that will generally be run everyday just after 7am, but occasionally could be run later during the day. In col D are ticket update times/dates. If the ticket was updated yesterday, then the cell should be left alone; if the ticket was not updated yesterday (IE, if today is the 3rd, and it has not been updated since X o'clock on the 1st) the cell should highlight. Since the report will occasionally not be run until later in the day, I can't do a simple CurrentTime - 24 hours to figure this out. I need the function to always look for the previous day and before 7am.
Without knowing exactly how to code this, I know it should be something like:
If ticketUpdateTime < currentDay at 0700 - 24
Then highlight (I know the code for this part already)
End If
Hopefully this makes sense
If DateDiff("h", CDate(ticketUpdateTime), CDate(Format(Now(), "mm/dd/yy")) + TimeSerial(7, 0, 0)) > 24 Then
highlight
End If
In plain English:
If the time elapsed between ticketUpdateTime and today's date at 07:00AM is more than 24 hours, highlight
It's a bit out of scope for the original question, but here's usage example as well:
Sub CheckTimes(rng As String)
Dim someRange As Range, someCell As Range
Set someRange = Range(rng) ' Convert input string to an actual range object
For Each someCell In someRange
If DateDiff("h", CDate(someCell.Value), CDate(Format(Now(), "dd/mm/yy")) + TimeSerial(7, 0, 0)) > 24 Then
Debug.Print "Highlight"
End If
Next cell
End Sub
To call it, input Call CheckTimes("D2:D100") or whatever range you need
Mind that there's no error-checking/-handling or data validation here - you'll have to do that yourself. ;-)
You may use dateserial(Year as integer, month as Integer, day as Integer) and TimeSerial(Hour as Integer, Minute as Integer, Second as Integer). I don't know how exactly you ticketUpdateTime looks like, so its hard to write expression. However, previous day 7 am would be:
dateserial(year(date-1), month(date-1), day(date-1)) & " " &timeserial(7, 0, 0)
Appears to be an of issue. All of the dates/times are yesterday except for the value in D2 which is 11/01/2017 10:47:02, and that value is not highlighting.
Call CheckTimes("D2:D" & lastRow)
Sub CheckTimes(rng As String)
Dim someRange As Range, someCell As Range
Set someRange = Range(rng) ' Convert input string to an actual range object
For Each someCell In someRange
If DateDiff("h", CDate(someCell.Value), CDate(Format(Now(), "dd/mm/yy")) + TimeSerial(7, 0, 0)) > 24 Then
someCell.Interior.Color = 16750899
End If
Next someCell
End Sub

Using VBA to check if a cell contains a date and if so advancing the date one month

I have a column of data (C) that has many cells that contain dates. I am trying to create a macro that checks to see if each cell contains a date and if it does then advance the date on month. I have the code to advance the date one month from here http://excel.tips.net/T002180_Automatically_Advancing_by_a_Month.html and it works fine but I am not sure how to replace the range with a dynamic range that evaluates all cells in column C. If possible I would also like to eliminate the need for a loop. Here is what I have so far.
Sub IncreaseMonth()
Dim dDate As Date
Dim NumberofTasks As Integer
NumberofTasks = ThisWorkbook.Worksheets("Dashboard").Range("Number_of_Tasks")
Dim x As Integer
For x = 1 To NumberofTasks
dDate = Range("C30").Value
Range("C30").Value = _
DateSerial(Year(dDate), _
Month(dDate) + 1, Day(dDate))
Next x
End Sub
Try something like the code below (I use DateAdd function to add 1 Month to the current date value)
Sub IncreaseMonth()
Dim dDate As Date
Dim NumberofTasks As Long
Dim x As Long
With Worksheets("Dashboard")
' I suspect you want to get the last row with data in Column C
NumberofTasks = .Cells(.Rows.Count, "C").End(xlUp).Row
For x = 1 To NumberofTasks
If IsDate(.Range("C" & x).Value) Then '<-- check if current cell at Column C is Date
.Range("C" & x).Value = DateAdd("m", 1, .Range("C" & x).Value) '<-- add 1 Month to current date in Column c, use DateAdd function
End If
Next x
End With
End Sub
This snippet should put you on the right track. I'm making a couple of assumptions here. The first is that you have a named range called "Number_of_Tasks" on which you wish to operate. Second is that all values in this range are a valid date. If values could be an invalid date (like a blank) you should check for this before setting the value.
You will also wish to ensure that the month does not become invalid. Incrementing the month past December will not be a valid date.
Sub IncreaseMonth()
Dim tempCell As Range
For Each tempCell In ThisWorkbook.Worksheets("Dashboard").Range("Number_of_Tasks")
tempCell.Value = DateSerial(Year(tempCell.value), Month(tempCell.value) + 1, Day(tempCell.value))
Next tempCell

Using a variable in coded date

I am trying to pull all data entries that are within a userform selected month and year. I can get the code to run fine when I hard code the year but I want the year to come off of a text box. I converted the Textbox value to an integer using Cint() and dim'd it to "Year" in my if statement. I can get it to work if I write Cdate("3/1/2016"), but I want see if there is a way to run it like: Cdate("3/1/Year"). I tried it this way and get a typematch error on the Cdate Im pretty new to VBA so excuse my stupidity.
Ignore the "Month" variable I was just using that to put a stop on the code and step it through to see if it would enter my if statement.
Thanks in advance.
My Code
Private Sub OKBtn_Click()
Dim Sales As Range
Dim Year As Integer
Dim Month As Integer
Dim i As Integer
Year = CInt(YearText.Value)
Set Sales = Worksheets("Sales").Range("A4")
i = 0
If Sales.Offset(i, 1).Value >= CDate("3/1/2016") And Sales.Offset(i, 1).Value <= CDate(" 3/31/2016 ") Then
Month = 1
End If
In order for the CDate to work, you need to seperate the stings inside the brackets to 2 parts
1.The constant, in your case "3/1/".
2.And the variable, CInt(YearText.Value).
Option Explicit
Private Sub OKBtn_Click()
Dim DDate As Date
DDate = CDate("3/1/" & CInt(YearText.Value))
' for debug only
MsgBox "Date entered is :" & DDate
End Sub

MS Excel: Finding the earliest date on a row of mixed content

Does anyone know how to get the earliest date on a row in Microsoft Excel. There is not a predictable number of columns on each row, and there are values other than dates which need to be ignored. It could be done with Excel formulas or VBA.
Does anyone have any suggestions?
Right now I am using this quick and dirty VBA function, but when I loaded new input data (approx 200 rows by 100 columns) a message box came up saying that Excel does not have enough resources to process my changes.
' returns smallest date on row
Public Function getSmallestDateFromRow(r As Integer, sheetName As String) As Date
Dim toReturn As Date
Dim rng As Range
Dim scanToColumn As Integer
Dim c As Integer
Dim tmp As Variant
Set rng = Sheets(sheetName).Cells.Find("*", [a1], , , xlByColumns, xlPrevious) 'is this inefficient?
scanToColumn = rng.Column
toReturn = #12/12/2100#
For c = 1 To scanToColumn
tmp = Sheets(sheetName).Cells(r, c).Value
If (IsDate(tmp)) Then
If (toReturn = Null) Then
toReturn = tmp
ElseIf (toReturn > tmp) Then
toReturn = tmp
End If
End If
Next c
If (toReturn = #12/12/2100#) Then
toReturn = 0
End If
getSmallestDateFromRow = toReturn
End Function
You have to remember that Excel (and many other Microsoft products) store dates as floating-point numbers:
The integer part is the count of days elapsed since January 1st, 1900 (e.g.: 1 is equivalent to 1/1/1900)
The decimal part is the 'fraction' of day elapsed (e.g.: 0.5 is equivalent to 12:00 pm)
The question on how to find a minimum or maximum date value is then obfuscated by the fact that you may have many other numbers in your row. So you have to define first a "valid rank" for the dates. After that, a simple "array formula" can do the trick:
Example. Let's say your valid range is between January 1st, 2000 and December 31st, 2100. Then your valid "number rank" is:
1/1/2000 is equivalent to 36526
12/31/2100 is equivalent to 73415
Now you can write the function to track the minimum date value within this range:
function trackMinimum(rowRange as range) as date
on error resume next
dim j as integer, minValue as date
dim t0 as double, t1 as double
dim ans as date
t0 = cdbl(dateserial(2000,1,1))
t1 = cdbl(dateserial(2100,12,31))
ans = 0
for j = 1 to rowRange.columns.count
if ans = 0 then ' You need to store the first valid value
if rowRange.cells(1,j).value >= t0 and rowRange.cells(1,j) <= t1 then
ans = rowRange.cells(1,j).value
end if
else
if (rowRange.cells(1,j).value >= t0 and rowRange.cells(1,j) <= t1) _
and rowRange.cells.value < ans then
ans = rowRange.cells(1,j).value
end if
end if
next j
trackMinimum = ans
end function
Of course I am assuming that the rowRange parameter is a single row range.
Hope this helps you
By the way, the isDate() function is not "fail safe": It must take a valid expression (text) to detect if it is a date or not, and that may depend on formatting. That said, you may prefer to use isDate(.cells(r,c).Text)' instead of.value, since theValue` property may return a double or floating-point value that can be evaluated as "not a date".