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
Related
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 was debugging this code but I am not sure why this is returning false instead of true.
?Day(i)>salday(0)
False
?Day(i)
31
?salday(0)
20
?isnumeric(day(i))
True
?isnumeric(salday(0))
True
Option Explicit
Option Compare Text
Sub genOP()
Dim wO As Worksheet
Dim i As Long, j As Long
Dim stDate, enDate, intVal, entR As Long, salDay, salAmt, stTime, enTime, dbMin, dbMax
Dim stRow As Long
Dim cet, curMn
'On Error Resume Next
Application.ScreenUpdating = False
stDate = STG.Range("B2"): enDate = STG.Range("B4")
intVal = Split(STG.Range("B3"), ","): entR = STG.Range("B5")
salDay = Split(STG.Range("B6"), "-")
salAmt = STG.Range("B7"): stTime = STG.Range("B8"): enTime = STG.Range("B9"): dbMin = STG.Range("B10"): dbMax = STG.Range("B11")
Set wO = ThisWorkbook.Sheets.Add
TEMP.Cells.Copy wO.Range("A1")
stRow = 19
curMn = Month(stDate)
For i = CLng(stDate) To CLng(enDate)
If stRow > 19 Then
wO.Rows(stRow & ":" & stRow).Copy
wO.Rows(stRow + 1 & ":" & stRow + 1).Insert Shift:=xlDown
Application.CutCopyMode = False
End If
cet = Trim(DESC.Range("A" & WorksheetFunction.RandBetween(2, DESC.UsedRange.Rows.Count)))
If STG.Range("B14") = "ON" Then
cet = cet & "Transaction amount " & Chr(34) & "&TEXT(H" & stRow & "," & Chr(34) & "#,##0.00" & Chr(34) & ")&" & Chr(34) & " GEL,"
End If
If STG.Range("B13") = "ON" Then
cet = cet & Chr(34) & "&TEXT(B" & stRow & "-1," & Chr(34) & "dd mmm yyyy" & Chr(34) & ")&" & Chr(34)
End If
If STG.Range("B12") = "ON" Then
cet = cet & " " & Format(stTime + Rnd * (enTime - stTime), "HH:MM AM/PM")
End If
If curMn = Month(i) And (Day(i) >= salDay(0) And Day(i) <= salDay(1)) Then 'Salary Day
cet = Trim(DESC.Range("A" & WorksheetFunction.RandBetween(2, DESC.UsedRange.Rows.Count)))
wO.Range("B" & stRow) = Format(i, "DD-MM-YYYY")
wO.Range("I" & stRow) = salAmt
wO.Range("L" & stRow) = MonthName(Month(i)) & "- Salome Baazov - " & "Geo" & " Ltd "
curMn = WorksheetFunction.EDate(i, 1)
Else
wO.Range("B" & stRow) = Format(i, "DD-MM-YYYY")
wO.Range("H" & stRow) = WorksheetFunction.RandBetween(dbMin, dbMax) + (WorksheetFunction.RandBetween(0, 1) * 0.5)
wO.Range("L" & stRow) = "=" & Chr(34) & cet & Chr(34)
End If
stRow = stRow + 1
i = i + intVal(WorksheetFunction.RandBetween(LBound(intVal), UBound(intVal))) - 1
Next i
wO.Rows(stRow).EntireRow.Delete
wO.Range("I" & stRow).Formula = "=SUM(I19:I" & stRow - 1 & ")"
wO.Range("H" & stRow).Formula = "=SUM(H19:H" & stRow - 1 & ")"
wO.Activate
Application.ScreenUpdating = True
STG.Range("B5") = stRow - 1
MsgBox "Process Completed"
End Sub
Because you are comparing two Variants with different types (As it turned out after our discussions... thx #MatsMug). The comparison result is undefined behavior when comparing Variants of different types, one numeric and one String.
It's the Variant anomalies once again.. Consider this MCVE:
Sub Test1()
Dim i, salday
i = CDate("5/30/2017")
salday = Split("20-20-20", "-")
Debug.Print Day(i), salday(0) ' 30 20
Debug.Print Day(i) > salday(0) ' False
Debug.Print Day(i) > CStr(salday(0)) ' True
' ^^^^
Debug.Print Val(Day(i)) > salday(0) ' True
' ^^^^
End Sub
Although salday(0) is a String Variant, explicitly converting it to String with CStr solved the issue. However, without that conversion, the comparison failed. VBA did not implicitly convert the number to a string or vice-versa. It compared two Variants of different types and returned a rubbish result.
For more about the Variant curse, read For v=1 to v and For each v in v -- different behavior with different types
As it turns out, using CLng or Val to force number comparison is the safe way to go, or CStr to force text comparison.
Consider further these three simple examples:
Sub Test1()
Dim x, y: x = 30: y = "20"
Debug.Print x > y ' False !!
End Sub
Sub Test2()
Dim x As Long, y: x = 30: y = "20"
' ^^^^^^
Debug.Print x > y ' True
End Sub
Sub Test3()
Dim x, y As String: x = 30: y = "20"
' ^^^^^^
Debug.Print x > y ' True
End Sub
As you can see, when both variables, the number and the string, were declared variants, the comparison is rubbish. When at least one of them is explicit, the comparison succeeds!
Dim stDate, enDate
This instruction declares two Variant variables. They're assigned here:
stDate = STG.Range("B2"): enDate = STG.Range("B4")
Assuming [B2] and [B4] contain actual date values, at that point the variables contain a Variant/Date. That's because the implicit code here is as follows:
stDate = STG.Range("B2").Value: enDate = STG.Range("B4").Value
But you probably know that already. Moving on.
salDay = Split(STG.Range("B6"), "-")
salDay is also an implicit Variant. That instruction is quite loaded though. Here's the implicit code:
salDay = Split(CStr(STG.Range("B6").Value), "-")
This makes salDay an array of strings. So here we are:
?Day(i)
31
?salday(0)
20
The leading space in front of 31 is because the immediate pane always leaves a spot for a negative sign. salDay(0) being a String, there's no leading space. That was your clue right there.
?Day(i)>salday(0)
False
With salday(0) being a String, we're doing a string comparison here, as was already pointed out. Except there's no leading space in front of the 31; the implicit code is this, because the type of Day(i) is Integer:
?CStr(Day(i)) > salDay(0)
False
The solution is to get rid of salDay altogether: you don't need it. Assuming [B6] also contains an actual date, you can get the day into an Integer right away:
?Day(STG.Range("B6").Value)
As a bonus you decouple your code from the string representation of the underlying date value that's in your worksheet, so changing the NumberFormat won't break your code. Always treat dates as such!
Basic setup is, there are 2 textboxes and 1 calendar (Datepicker).
In textbox1, user enter date in either of the format mentioned below, press enter, date
gets selected on the calendar.
03-Feb
03-Feb-17
03-Feb-17
In textbox2, user enter days that needs to be added or subtracted as below, press enter,
date gets selected on the calendar.
+1, +15, +32... and so on to add days
-1, -12, -21... and so on to subtract days
Textbox1 code below works fine -
Option Explicit
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim txt As String, dayStr As String, monthStr As String, yearStr As String
Dim okTxt As Boolean
txt = Me.TextBox1.Value
Select Case Len(txt)
Case 2
dayStr = txt
okTxt = okDay(dayStr)
monthStr = Month(Now)
yearStr = Year(Now)
Case 5
dayStr = Mid(txt, 3, 3)
monthStr = Mid(txt, 3, 3)
okTxt = okDay(Left(txt, 2)) And okMonth(monthStr)
yearStr = Year(Now)
Case 7
dayStr = Mid(txt, 3, 3)
monthStr = Mid(txt, 3, 3)
yearStr = Mid(txt, 6, 2)
okTxt = okDay(Left(txt, 2)) And okMonth(monthStr) And okYear(yearStr)
End Select
If Not okTxt Then
MsgBox "Invalid date" _
& vbCrLf & vbCrLf & "Date must be input in one of the following formats:" _
& vbCrLf & vbTab & "dd" _
& vbCrLf & vbTab & "ddmmm" _
& vbCrLf & vbTab & "ddmmmyy" _
& vbCrLf & vbCrLf & "Please try again", vbCritical
Cancel = True
Else
Me.Calendar1.Value = CDate(Left(txt, 2) & " " & monthStr & " " & yearStr)
End If
End Sub
Function okDay(txt As String) As Boolean
okDay = CInt(txt) > 0 And CInt(txt) < 31
End Function
Function okMonth(txt As String) As Boolean
Const months As String = "JANFEBMARAPRMAJJUNJULAUGSEPOCTNOVDEC"
okMonth = InStr(months, UCase(txt)) > 0
End Function
Function okYear(txt As String) As Boolean
okYear = CInt(txt) > 0 And CInt(txt) < 200 '<--| set your "limit" years
End Function
Textbox2 code below is where I need assistance -
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Ln As Variant
Dim x As Variant
Dim d As Variant
Dim fmt As Variant
If IsNumeric(Left(TextBox1, 2)) Then Ln = 0 Else Ln = 1
x = Left(TextBox2.Value, 1)
If x <> "-" And x <> "+" Then MsgBox "Please use an operator with your value":: Exit Sub
d = TextBox1.Value
Select Case Len(d)
Case 4, 5
d = Left(d, 2 - Ln) & "-" & Right(d, 3)
fmt = "ddmmm"
Case 6, 7
d = Left(d, 2 - Ln) & "-" & Mid(d, 3 - Ln, 3) & "-" & Right(d, Len(d) - (5 - Ln))
fmt = "ddmmmyy"
Case 8, 9
d = Left(d, 2 - Ln) & "-" & Mid(d, 3 - Ln, 3) & "-" & Right(d, Len(d) - (5 - Ln))
fmt = "ddmmmyyyy"
End Select
MsgBox Format(CDate(d) + Val(TextBox2.Value), fmt)
End Sub
Currently what is happening is -
User enter days that needs to added or subtracted in textbox2, press enter, a messagebox
appears showing the end result.
Rather than a messagebox, I simply want the code to select the end result on the calendar.
I'm not sure how to change textbox2 code to achieve this.
Kindly assist.
Note : Just like textbox1, where the code selects the date on calendar, I want textbox2 code to do the same, which is select date on calendar after days are added or subtracted.
substitute:
MsgBox Format(CDate(d) + Val(TextBox2.Value), fmt)
with:
Me.Calendar1.Value = CDate(d) + Val(TextBox2.Value)
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
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) & """)"