I have written a code which gives me a sequence of dates in the form of "mmm yy" format. e.g. Jan 15 .
For i = 1 To 20
MsgBox Format(DateAdd("m", i, "01/01/2005"), "mmm") & " " & Right(Year(Date), 2)
Next i
The problem I am having is that when i goes on increasing the year does not change. So for example if i is 12 then it should be Jan 06 but still it gives me Jan 05 again. I want to generate a sequence from Jan 05 to Today i.e. Sep 15 Please advice.
Create a variable and add to that date.
Private Sub CommandButton1_Click()
Dim dDate As Date
Dim i As Integer
dDate = "01/01/2005"
For i = 1 To 20
MsgBox Format(dDate, "mmm") & " " & Right(Year(dDate), 2)
dDate = DateAdd("m", 1, dDate)
Next i
End Sub
Consider:
Sub oiudskfh()
For i = 1 To 20
Dim d As Date
d = DateAdd("m", i, "01/01/2015")
MsgBox Format(d, "mmm") & " " & Right(d, 2)
Next i
End Sub
Related
I have a file I want to pickup from the previous wednesday June 10th. I will be running my code today (Sunday June 14th). However this will reoccur every week.
Is there a way I can make my code dynamic enough to pickup the previous wednesday date?
Here is my code Set wbTarget = Workbooks.Open("C:\extract\Business_Report_20200527.xlsx")
Can I alter that path to dynamically pickup a date?
Thank you.
Try this:
Dim today As Date
Dim IntervalType As String
Dim FilePath As String
today = Date()
IntervalType = "d"
While Weekday(today) <> vbWednesday
today = DateAdd(IntervalType, -1, today)
Wend
FilePath = "C:\extract\Business_Report_" + Format(today, "yyyymmdd") + ".xlsx"
Set wbTarget = Workbooks.Open(FilePath)
Another way to do it:
Sub Test()
MsgBox "Last Wednesday: " & PreviousWednesday & vbCr & _
"Wednesday prior to 9th June: " & PreviousWednesday(DateValue("9 June 2020")) & vbCr & _
"Last Wednesday formatted: " & Format(PreviousWednesday, "yyyymmdd")
'Your code:
'Set wbTarget = Workbooks.Open("C:\extract\Business_Report_" & Format(PreviousWednesday, "yyyymmdd") & ".xlsx")
End Sub
Public Function PreviousWednesday(Optional CurrentDate As Date) As Date
If CurrentDate = 0 Then CurrentDate = Date
PreviousWednesday = (CurrentDate - Weekday(CurrentDate, vbMonday) + 1) - 5
End Function
I was writing a code that automatically checks if a cell (in column K) contains a date. It only should give an error if column K doesn't contain a date AND the date in column L is more than 30 days ago.
I've found out that my code works, but not for all dates. So I Debug.print and saw that he just ignores the fact that the if requirement isn't met. I've never experienced this.
This is the code (under it you'll find the debug)
Aantal = 0
i = 0
LastRow = 0
k = 0
LastRow = ThisWorkbook.Sheets("Acknowledgements follow up").Range("A1").End(xlDown).Row
'For i = 2 To LastRow
For i = 22214 To 22222
Debug.Print ActiveWorkbook.Sheets("Acknowledgements follow up").Range("L" & i).Value & " " & ActiveWorkbook.Sheets("Acknowledgements follow up").Range("K" & i) + 30 & " "; Date & vbCrLf
If ActiveWorkbook.Sheets("Acknowledgements follow up").Range("L" & i).Value = "" And ActiveWorkbook.Sheets("Acknowledgements follow up").Range("K" & i) + 30 > Date Then
Aantal = Aantal + 1
MsgString = MsgString & i & " / "
End If
Next i
If MsgString <> "" Then MsgString = Left(MsgString, Len(MsgString) - 3)
If Aantal > 1 Then
MsgBoxAnswer = MsgBox("There are " & Aantal & " dates missing in the acknowlegement sheet" & vbCrLf _
& "The missing dates are on rows " & MsgString, vbOKOnly + vbExclamation, "Missing dates")
End If
If Aantal = 1 Then
MsgBoxAnswer = MsgBox("There is " & Aantal & " date missing in the acknowlegement sheet" & vbCrLf _
& "The missing date is on row " & MsgString, vbOKOnly + vbExclamation, "Missing dates")
End If
I've found that cell 22217 contains a case where he should give an error. But he doesn't, the whole document contains more than 29000 rows. It gives me 58 errors but in reality there're way more.
This is the debug info I got (Check if date is empty (Column L) / Column K + 30 days / today)
05-08-13 01-09-13 06-11-17
05-08-13 01-09-13 06-11-17
05-08-13 01-09-13 06-11-17
01-09-13 06-11-17
05-08-13 04-09-13 06-11-17
06-08-13 04-09-13 06-11-17
05-08-13 04-09-13 06-11-17
05-08-13 04-09-13 06-11-17
30-12-13 04-09-13 06-11-17
As you can see it recognises that row 22217 is empty and the date is longer than 30 days. So it should be triggered. I found out that it is this line that doesn't work properly: ActiveWorkbook.Sheets("Acknowledgements follow up").Range("K" & i) + 30 > Date
Any ideas?
Thanks!
KawaRu
This works on my system for testing dates older than 30 days:
Option Explicit ' Always start every VBA file with this
Option Base 0 ' Not as important, but I use it as a reminder to myself
Public Sub KawaRu()
Dim CL As Long, CK As Long ' Column numbers for L, K
CL = AscW("L") - AscW("A") + 1
CK = AscW("K") - AscW("A") + 1
' Always Dim your variables, and use Option Explicit
Dim aantal As Long, i As Long, LastRow As Long, k As Long
Dim MsgString As String
aantal = 0
i = 0
k = 0
' Avoid repeating references to objects. Instead, save them in a variable.
Dim sh As Worksheet
Set sh = ActiveWorkbook.Sheets("Acknowledgements follow up")
LastRow = sh.Range("A1").End(xlDown).Row
For i = 1 To LastRow
Debug.Print sh.Range("L" & i).Value, sh.Range("K" & i) + 30, Date
' Use Cells() for speed when you're in a loop.
If sh.Cells(i, CL).Value = "" And _
sh.Cells(i, CK) < (Date - 30) Then
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ older than 30 days
aantal = aantal + 1
MsgString = MsgString & i & " / "
End If
Next i
Debug.Print aantal
If MsgString <> "" Then MsgString = Left(MsgString, Len(MsgString) - 3)
Dim MsgBoxAnswer As VbMsgBoxResult
If aantal > 1 Then
MsgBoxAnswer = MsgBox("There are " & aantal & " dates missing in the acknowlegement sheet" & vbCrLf _
& "The missing dates are on rows " & MsgString, vbOKOnly + vbExclamation, "Missing dates")
End If
If aantal = 1 Then
MsgBoxAnswer = MsgBox("There is " & aantal & " date missing in the acknowlegement sheet" & vbCrLf _
& "The missing date is on row " & MsgString, vbOKOnly + vbExclamation, "Missing dates")
End If
End Sub
My test data was:
col. A K L M
x 5/8/2013 1/9/2013 6/11/2017
x 1/9/2013 6/11/2017
x 1/9/2013 6/11/2017
x 11/1/2017 6/11/2017
The result I get is:
There are 2 dates missing in the acknowledgement sheet
The missing dates are on rows 2/ 3
Edit
The algorithmic problem was the date test. Kx + 30 > Date tests whether the value in column K is within the last 30 days, not older than 30 days. In the code above, Kx < (Date - 30) tests for older than 30 days. (Kx + 30) < Date (less than) would do the same.
An improvement on the code above would be to rename CK and CL. Instead of naming them after their locations, name them after their meanings. E.g., COL_ACK_RECEIVED or something. That will make it easier to understand your code when you come back to it later.
Edit 2
As #HarassedDad noted in a comment, be careful of d/m/y vs. m/d/y and other date-format issues.
"Older than 30 days" might mean < Date - 30 or <= Date - 30, depending on your requirements.
For future readers who may be looking at adapting this, remember that "30 days ago" and "last month" are very different!
This answer regarding Range.Value is a good one. I will add that using CStr() or other converter functions is a good practice, since Range.Value returns a Variant.
This question and this question, and their answers, are good reading re. why = "" might not always match a cell that appears to be empty.
I am getting an "expected array" error on Today = Day(Today()). I have no idea what is wrong.
Dim Thisday As Integer
Dim Montho As Integer
Dim Yearo As Integer
Dim Lday As Integer
Dim last as Integer
last = Cells(Rows.Count, "A").End(xlUp).Row
Thisday = Day(date)
Montho = Month(date)
Yearo = Year(date)
Lday = Day(Application.WorksheetFunction.EoMonth(Date, -1))
Then Column B in excel gets populated with the same date, either the 15th or the last day.
If Thisday <= 15 Then
Range("B2:B" & Last).Value = Montho & "/15/" & Yearo
End If
If Thisday > 15 Then
Range("B2:B" & Last).Value = Montho & "/" & Lday & "/" & Yearo
End If
End Sub
Also not every month ends on the 30th, so how do get the Lday should return the as day of the month.
Use Date instead of Today.
Do not use the same name as functions, excel gets messed up.
vba does not have EoMonth it is part of Application.WorksheetFunction. It also returns a date or double not an integer. You will need to get the Day:
Dim Today As Integer
Dim Montho As Integer
Dim Yearo As Integer
Dim Lday As Integer
Dim last As Integer
last = Cells(Rows.Count, "A").End(xlUp).Row
Today = Day(Date)
Montho = Month(Date)
Yearo = Year(Date)
Lday = Day(Application.WorksheetFunction.EoMonth(Date, 0))
If Today <= 15 Then
Range("B2:B" & Last).Value = Montho & "/15/" & Yearo
End If
If Today > 15 Then
Range("B2:B" & Last).Value = Montho & "/" & Lday & "/" & Yearo
End If
The above code returns a string that looks like a date. To return a true date use this:
Dim Today As Integer
Dim Montho As Integer
Dim Yearo As Integer
Dim last As Integer
last = Cells(Rows.Count, "A").End(xlUp).Row
Today = Day(Date)
Montho = Month(Date)
Yearo = Year(Date)
Range("B2:B" & Last).NumberFormat = "mm/dd/yyyy"
If Today <= 15 Then
Range("B2:B" & Last).Value = DateSerial(Yearo, Montho, 15)
End If
If Today > 15 Then
Range("B2:B" & 4).Value = Application.WorksheetFunction.EoMonth(Date, 0)
End If
Try,
Range("B2:B" & Last).Value = dateserial(year(date), month(date)-(day(date)>15), 15 * abs(day(date)<=15))
Once month(now) + x => 13 I get an error using MonthName in VBA.
Without building out too much more code is there an easy workaround I'm missing? Only thing I can think of is to set some conditionals inside the loop to adjust it so the month(now) + x reverts back to 1 once it hits 13.
Also looks like I'll have a problem with Year(Now) too once it gets past 13 but one thing at a time.
Code:
Sub Do_Stuff_Button()
expand = 2
MsgBox Day(Now)
ActiveSheet.Cells(2, 6) = "'" & MonthName(Month(Now), False)
ActiveSheet.Cells(1, 6) = "'" & Year(Now)
Do While expand > 0
ActiveSheet.Cells(1, (6 - expand)) = "'" & Year(Now)
ActiveSheet.Cells(1, (6 + expand)) = "'" & Year(Now)
ActiveSheet.Cells(2, (6 - expand)) = "'" & MonthName((Month(Now) - expand), False)
ActiveSheet.Cells(2, (6 + expand)) = "'" & MonthName((Month(Now) + expand), False)
expand = expand - 1
Loop
End Sub
You can use DateAdd.
Debug.Print MonthName(Month(DateAdd("m", 1, Date)))
If you were to pass a number into the function, which is greater than the number of remaining months in the current year, then it will calculate the month continuing into the following year.
Example
Debug.Print MonthName(Month(DateAdd("m", 5, Date)))
The above will return March.
you can use the Mod operator to check if there is any value remaining and then pass that as the month value
Dim monthVal As Integer
If (Month(Now) + x) Mod 12 > 0 Then
monthVal = (Month(Now) + x) Mod 12
Else
monthVal = Month(Now) + x
End If
MonthName (monthVal)
You can use Format for MonthName:
Debug.Print Format(Now(), "mmmm yyyy")
Debug.Print Format(DateAdd("m", 1, Now()), "mmmm yyyy")
Deals with year rollover as well as month roll over
Can someone please help me to fix the formula in the sub. I need to enter dates into it via variables but it always gives me an error '13' data types
I'm talking about the bit:
Cells(5, field).FormulaLocal = "=SUMMEWENNS(Rawdata!K2:K3446;Rawdata!I2:I3446;""bezahlt"";Rawdata!A2:A3446;" >= " & weekstart & "";Rawdata!A2:A3446;" <= " & weekend & "")"
The Sub apart from that formula works.....
Sub get_cal_weeks()
Dim weeks As Integer, i As Integer, col As String, weekstart As Date, weekend As Date, calweeks() As Variant
'start column is D
col = "D"
'get amount of weeks
weeks = countcalweeks()
'populate array calweeks
calweeks = fillcalweeks(weeks)
For i = 0 To weeks
field = i + i + 4
weekstart = calweeks(i, 0)
weekend = calweeks(i, 1)
Cells(5, field).FormulaLocal = "=SUMMEWENNS(Rawdata!K2:K3446;Rawdata!I2:I3446;""bezahlt"";Rawdata!A2:A3446;" >= " & weekstart & "";Rawdata!A2:A3446;" <= " & weekend & "")"
Next
End Sub
Thank you
I suggest you convert to long (or double if you need times)
Cells(5, field).FormulaLocal = "=SUMMEWENNS(Rawdata!K2:K3446;Rawdata!I2:I3446;""bezahlt"";Rawdata!A2:A3446;"">=" & CLng(weekstart) & """;Rawdata!A2:A3446;""<=" & CLng(weekend) & """)"