I need to auto fill a specific column with a date. If the date occurs between Saturday through Tuesday, I need to auto fill the date column with the previous Friday. If the date occurs between Wednesday and Friday I need to put in the coming Friday date for the auto fill.
For example: If I run the spreadsheet on Tuesday 10/23 I need the auto fill date to be Friday 10/19. If I run the spreadsheet on Wednesday 10/24 I need the auto fill date to be Friday 10/26.
Here is the formula I have so far, so I need to invoke this formula via macro when saving the spreadsheet or by clicking a custom button. Any assistance would be greatly appreciated.
=IF(ISBLANK($A2),"",IF(WEEKDAY(TODAY())<4,(TODAY()+(-1-WEEKDAY(TODAY()))),(TODAY()+(6-WEEKDAY(TODAY())))))
I'd suggest using VBA for what you want, something like this which would go in the ThisWorkbook module and run prior to the workbook saving:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Check if A2 is blank
If Cells(2, 1) = "" Then Exit Sub
'Find the date and use it
Dim x As Long
Dim dateToUse As Date
x = Weekday(Date, vbSaturday)
If x <= 4 Then
dateToUse = Date - x
Else
dateToUse = Date + (7 - x)
End If
'Change Cells(1, 1) to the actual target you want to have the date,
'which could be determined based upon the contents of your workbook/sheet.
Cells(1, 1) = dateToUse
End Sub
Related
Afternoon all;
I'm looking for some advice on a MS Access 2016 app that I've been working on. I have a form with a combo box that is sourced from a table containing a week beginning date (Monnday) and a week ending date (Sunday).
My hope was that when the form was opened, the combo box would jump to the current week's Monday. For example, today is the third, so the combo box would have 2/1/21 - 2/7/211 pre-selected.
Is there a way to do this or is this a pipe dream?
Any suggestions would be most appreciated.
I think it will be something like this.
Private Sub Command_Click()
Dim sDate As String
Dim i As Integer
sDate = "01/01/" & Year(Date)
If Day(CDate(sDate)) <> vbMonday Then
sDate = DateAdd("d", vbMonday - Day(CDate(sDate)) - 1, CDate(sDate))
End If
For i = 0 To 51
Combo1.AddItem Format(DateAdd("ww", i, sDate), "mmm dd, yyyy")
If Date > DateAdd("ww", i, sDate) And Date < DateAdd("ww", i + 1, sDate) Then
Combo1.ListIndex = i
End If
Next i
End Sub
Also, see the relevant discussion from the link below.
MS Access 2010 (Design View): return Monday of the current week with Monday as 1st day of the week
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.
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.
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).
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!