Excel_VBA highlight cells which has current date and different time - vba

Need help to highlight the cell which contains today's date and a different time. The code that I wrote is here, but it can only highlight the cells with the current date.
Sub Datechoose()
Dim rCell As Range
With Worksheets("owssvr")
For Each rCell In .Range("A2:M20")
If rCell.Value = Date Then
rCell.Interior.Color = vbGreen
End If
Next
End With
End Sub
enter image description here
My aim is to highlight the cells with the current date(6/22/2018 and time).
Please help me out...

Highlight your cells and give them a conditional format.
With A1 selected the condition below will return TRUE if the date portion of the date/time value is equal to todays date.
=INT(A1)=TODAY()
As #HarassedDad said - 12 noon will be 43273.5 for 22nd June 2018.
INT(43273.5) cuts off the time leaving just the date to compare against your date value.

Wrap the 2 comparison values in a format to ensure Excel reads them in the same manner.
if isdate(rCell) then
If format(rCell.Value, "mm/dd/yyyy") = format(Date, "mm/dd/yyyy") Then
rCell.Interior.Color = vbGreen
End If
end if
Edit 1
you'll get an overflow error if the cell value is a numeric value outside of valid date parameters. You can avoid this by using the 'isDate' function to verify the cell is a date and can handle the format.

Related

VBA - day and month values flip when I get my macro save the csv file

I am having trouble pasting dates to a csv file, as once the file is saved and reopened the day and month digits flip.
The date is copied from one of my excel cells ("09/07/2021", and its "dd/mm/yyyy" format)
I open an existing csv file, insert this date in one of the columns and in the next column add 10 to that date. I run a loop to repeat this for 9 rows.
before saving this is how it looks
Once I get my code to save the csv file and I re-open, this is what I see
Any idea how to fix this? my codes are below.
Sub date_issue_csv3()
'take the date from another workbook
dateV = Worksheets("main").Range("c2").Value
ThisWorkbook.Activate
Workbooks.Open (Range("c11").Value)
rowsC = 9
For i = 1 To rowsC
Range("g1").Offset(i, 0).Value = dateV
Range("g1").Offset(i, 1).Value = DateAdd("d", 10, dateV)
Next i
Workbooks(wb2).Close SaveChanges:=True
End Sub
Fallen foul of this one myself enough times. dd/mm/yyyy and mm/dd/yyyy date formats are easily misinterpreted for anything up to the 12th of any month.
As per #Maciej_Los's suggestion, ISO date format yyyy/mm/dd is universally recognised and never gets misinterpreted by Excel or other programs (because honestly what psychopath would try yyyy/dd/mm).
Change your loop as follows:
For i = 1 To rowsC
Range("g1").Offset(i, 0).Value = dateV
Range("g1").Offset(i, 1).Value = Format(DateAdd("d", 10, dateV), "yyyy/mm/dd")
Next i

Current date plus time VBA

I want to create a button which will do the following.
- Retrieve the current date and time -->
- This date and time plus the time in (O2) -->
- In the range of cells (L2:L11) needs to be displayed if the current time plus the time in cell O2 is less or more than the date and time in the cell next to it (Range M2:M11). The cell L2 will be compared with M2, L3 with M3 etc.
On any current time, you will be able to click on the button and it will calculate if it is on time or too late.
I know how to get the current date but can't get any further.
Click here for the image with the cells
Sub OnTime()
With Range("L2:L11")
.Value = Now()
.NumberFormat = "mm/dd/yyyy h:mm:ss AM/PM"
End With
End Sub
Why don't you simply do this
In cell O2 type "=now"
in cell L2 type "=IF(B1<D1,"Ontime", "Late")"
After that each time you refresh the formulaes it will be recalculated. Do that by linking this macro to a button
Sub Refresh_formulaes()
Calculate
End Sub

VBA - Selecting cells that contain dates for the past 5 years

I currently have a spreadsheet that has the dates (excluding weekends and holidays) for the past 10 years in column A. For example, A1 contains "7/19/2007" and A2520 contains "7/19/2017"
Column E contains the closing price for the stock SPY on those corresponding dates.
I am trying to figure out the standard deviation for the past 5 years. In order to do so, my idea was to write a VBA code that would select today's date and the previous five years, and then use that to calculate the standard deviation.
This list is updated everyday, meaning tomorrow, it will contain 7/20/2017 and the closing price for that day. My issue is that I cannot figure out how to make it so it will select today's date and the past five years, so then I can calculate the standard deviation.
Thank you guys for all your help! Sorry if this seems simple, I have just started learning VBA last week!
How's this? I make a few assumptions, like your dates are contiguous, and there's no empty cell in your Date column. I also assume your dates are in order, ascending. (So your day 10 years ago is in say row 10, and today is in row 1000).
Sub get_difference()
Dim dateRng As Range, cel As Range, priceRng As Range
Dim dateCol As Long, stockCol As Long, lastDate As Range
Dim tdyDate As Date, decadeAgo As Date
dateCol = 1 ' column A has your dates
stockCol = 5
tdyDate = WorksheetFunction.Text(Now(), "mm/dd/yyyy")
decadeAgo = get_Previous_Date(tdyDate)
Debug.Print decadeAgo
With Sheets("Stock Prices") ' change name as necessary
With .Columns(dateCol)
Set lastDate = .Find(what:=tdyDate) ' Assuming no break in data from A1
'lastDate.Select
Set cel = .Find(what:=decadeAgo)
'cel.Select
End With
Set rng = .Range(.Cells(cel.Row, dateCol), .Cells(lastDate.Row, dateCol))
'rng.Select
Set priceRng = rng.Offset(0, stockCol - dateCol)
'priceRng.Select
'priceRng.Offset(0, 1).Select
priceRng.Offset(0, 1).FormulaR1C1 = "=IFERROR((RC[-1]/R[-1]C[-1])-1,"""")"
End With
End Sub
Function get_Previous_Date(Dt As Date) As Date
' https://www.mrexcel.com/forum/excel-questions/37667-how-subtract-year-date-2.html
Dim numYearsBefore as Long, numDaysBefore as Long, numMonthsBefore as Long
numYearsBefore = 10 ' Change this to any amount of years
numDaysBefore = 0
numMonthsBefore = 0
get_Previous_Date = DateSerial(Year(Dt) - numYearsBefore, Month(Dt) - numMonthsBefore, Day(Dt) - numDaysBefore)
End Function
Make changes as needed, i.e. sheet name (I called mine "Stock Prices"), and the columns. It's also a little verbose, and could be made more compact, but I figured it'd help you learn to keep it like that. I suggest stepping through with F8 to see what happens, and uncommenting the .select lines so you can visually see what it's doing.

Overflow when using DateAdd Excel VBA

I currently have an Excel sheet with a series of dates and a cell in a different sheet with the date when we last ran this macro.
I need to write a macro which checks if today's date is at least 32 days after the day we last ran the macro.
If so, I want to search the sheet with the series of dates and add 10-dates to a dates array.
The dates that we add represent each the closes n*30 days prior to today's date with n which goes from 1 to 10.
So basically 10-dates each representing a multiple of 30-days prior to todays date.
BUT, these dates must be present in the sheet with the series of dates mentioned above so if for example subtracting 30 days from today gives a date which does not exist in the series of dates above, we keep subtracting 1 additional day until we find a date which exists.
Hope this makes sense. I understand it is a bit confusing but I felt I had to give some context.
My code:
Sub date_diff()
Dim todDate
Dim dt
Dim diff As Long
Dim dates(0 To 9) As Date
Dim i As Long
todDate = Format(ActiveWorkbook.Sheets("Overview").Range("B6").Value, "mm/dd/yyyy")
' dt is the Date of last signaling
dt = ActiveWorkbook.Sheets("Overview").Range("B5").Value
diff = DateDiff("d", dt, todDate)
Dim rng As Range
Dim dtCell As Range
Dim currDt
If diff < 32 Then
MsgBox "Wait " & (32 - diff) & " days"
Else
For i = 1 To 10
currDt = Format(DateAdd("d", 20, todDate), "mm/dd/yyyy") ---> OVERFLOW HERE
Set rng = ActiveWorkbook.Sheets("US Stocks").Range("A:A")
' Find the day - Loop until you find one at least 30 days apart
Do While rng.Find(What:=currDt) Is Nothing
currDt = DateAdd("d", -1, currDt)
Loop
dates(i) = currDt
MsgBox i
Next i
End If
End Sub
Run-time error '6':
Overflow
I suppose the error is coming from how I handle or how the dates are interpreted in VBA. SEE CODE FOR OVERFLOW LINE. I am very new to VBA so am still learning these subtleties. FYI, the dates are in the "Short Date" format such as 1/13/15 (mm/dd/yy).

Excel VBA code to compare system date with date in the worksheet

I want a vba code to compare the system date with the date i mentioned in a row (A) in excel worksheet. If the dates are equal then it should compare the system time and the time mentioned in a row (B). Eg: If the time mentioned in the sheet is 7 30 PM and the system time is 7 PM, it should calculate the time between and display. If the date in the sheet does not matches then it should leave.
Thanks in advance.
I put together a small procedure to get you started. It assumes the date/time in the worksheet is in cell A1. If the system date is the same as the date in cell A1, it then compares the system time with the time in cell A1. If they are the same to the minute then nothing happens.
However, if they are different then the number of minutes by which they are different appears in cell B1.
Here is the code:
Public Sub DateTimeCheck()
Dim d As Double
Dim s1 As String
Dim s2 As String
s1 = Format([a1], "dd-mm-yyyy hh:mm")
s2 = Format(Now, "dd-mm-yyyy hh:mm")
If Left$(s2, 10) = Left$(s1, 10) Then
d = TimeValue(Right$(s2, 5)) - TimeValue(Right$(s1, 5))
If d Then
[b1] = d * 1440
End If
End If
End Sub
Now, if you have more cells with dates in column A and you want to compare them as well, then you will need to modify this code so that it "processes" all of them.
As far as writing the difference in minutes to the email... we would need much more detail for that!