Hello I have variable with current date and I want to change the month of the date to the name of the month or any letter.
My variable has value: 19.10.2020
In short, I want to change 10 to oct or, for example, AA
How can i do it in VBA?
Whenever having a formatting question, a good option is to see what the VBA Excel macro recorder does, when the task is carried out.
In this case, formatting the cells like this:
will generate the following code:
Sub Macro1()
'
' Macro1 Macro
'
'
Selection.NumberFormat = "[$-409]d-mmm-yy;#"
Range("G8").Select
End Sub
Thus, Range("A1").NumberFormat = "[$-409]d-mmm-yy;#" would be a working answer.
You can write a conversion function.
For example:
Private Sub CommandButton1_Click()
MsgBox (GetNewMonth("19.10.2020"))
End Sub
Private Function GetNewMonth(ByVal datestring As String) As String
Dim splitted() As String
splitted = Split(datestring, ".")
Dim day As String
Dim month As String
Dim year As String
day = splitted(0)
month = splitted(1)
year = splitted(2)
GetNewMonth = day & " " & ConvertMonthNumToLetter(CInt(month)) & " " & year
End Function
Private Function ConvertMonthNumToLetter(ByVal monthnum As Integer)
Select Case monthnum
Case 1
ConvertMonthNumToLetter = "JAN"
Case 2
ConvertMonthNumToLetter = "FEB"
Case 3
ConvertMonthNumToLetter = "MAR"
Case 4
ConvertMonthNumToLetter = "APR"
Case 5
ConvertMonthNumToLetter = "MAI"
Case 6
ConvertMonthNumToLetter = "JUN"
Case 7
ConvertMonthNumToLetter = "JUL"
Case 8
ConvertMonthNumToLetter = "AUG"
Case 9
ConvertMonthNumToLetter = "SEP"
Case 10
ConvertMonthNumToLetter = "OCT"
Case 11
ConvertMonthNumToLetter = "NOV"
Case Else
ConvertMonthNumToLetter = "DEC"
End Select
End Function
OUTPUT:
19 OCT 2020
First, convert to a string that can be read as a date, then format this - like:
=Format(Replace("AA", ".", "/"), "d.mmm.yyyy")
-> 10.Okt.2020
Related
First of all, I'm a beginner and still learning VBA, thank you for your consideration.
I have a CalcWorkingDays function which which calculates working days within a specific period (period defined by a query parameter).
But when it returns results, for some periods it is completely correct, and for some others it's incorrect (See example at the end)
I guess the problem is in these lines :
If Format(DateCnt, "w") <> "7" And _
Format(DateCnt, "w") <> "6" Then
Thank you !
Public Function CalcWorkingDays(BegDate As Variant, EndDate As Variant) As Integer
Dim WholeWeeks As Variant
Dim DateCnt As Variant
Dim EndDays As Integer
On Error GoTo Err_Work_Days
BegDate = DateValue(BegDate)
EndDate = DateValue(EndDate)
WholeWeeks = DateDiff("w", BegDate, EndDate)
DateCnt = DateAdd("ww", WholeWeeks, BegDate)
EndDays = 0
Do While DateCnt <= EndDate
If Format(DateCnt, "w") <> "7" And _
Format(DateCnt, "w") <> "6" Then
EndDays = EndDays + 1
End If
DateCnt = DateAdd("d", 1, DateCnt)
Loop
CalcWorkingDays = WholeWeeks * 5 + EndDays
Exit Function
[...]
End Function`
For example, on march 2019.
there is a total of 21 working days. We have both employees A and B
A : he's on a project from 01/01/2019 to 31/12/2019, the function gives me 21 working days for march which is correct
B : He's been assigned to a project from 01/03/2019 to 08/03/2019, it gives me 5 which is incorrect, it should give me 6 (8 total days days - 2 days for week end
Harassed Dad is right - if you use Format(DateCnt, "w"), Sunday will be "1", Monday "2"...
But you shouldn't use Format to get the day of the week - Format is for formatting data into strings, and there is no need to involve strings. Use the Weekday-function instead.
The default behavior for Weekday is that Sunday will be 1 (as a number, not a string), but you can change that with the 2nd parameter (FirstDayOfWeek). This defines which day you want to have as first day of the week.
So you can change your logic for example to
If Weekday(DateCnt, vbMonday) < 6 Then
Date arithmetic is tricky. If you are not hugely concerned about efficiency and your intervals are relatively small then a really simple function will do the trick
Public Function CalcWorkingDays(BegDate As Variant, EndDate As Variant) As Integer
CalcWorkingDays = 0
For i = begdate To enddate
If Weekday(i, vbMonday) <= 5 Then
CalcWorkingDays = CalcWorkingDays + 1
End If
Next
End Function
Not particularly elegant but effective, easy to understand, and easy to modify.
The function gives me 21 working days for march which is correct B
He's been assigned to a project from 01/03/2019 to 08/03/2019, it
gives me 5 which is incorrect, it should give me 6.
A diff-function will never include the last date. If you wish to include that last date, add one day to the last date before calculating:
? DateDiffWorkDays(#2019/03/01#, #2019/03/31#)
21
? DateDiffWorkDays(#2019/03/01#, #2019/04/01#)
21
? DateDiffWorkDays(#2019/03/01#, #2019/03/08#)
5
? DateDiffWorkDays(#2019/03/01#, #2019/03/09#)
6
Also, as already noted, specify Monday as the first day of the week. Further, don't use Format; Weekday is the "direct" method. Thus:
If Weekday(DateCnt, vbMonday) < 6 Then
EndDays = EndDays + 1
End If
For an extended method that takes holidays into account, study my functions:
Option Compare Database
Option Explicit
' Returns the count of full workdays between Date1 and Date2.
' The date difference can be positive, zero, or negative.
' Optionally, if WorkOnHolidays is True, holidays are regarded as workdays.
'
' Note that if one date is in a weekend and the other is not, the reverse
' count will differ by one, because the first date never is included in the count:
'
' Mo Tu We Th Fr Sa Su Su Sa Fr Th We Tu Mo
' 0 1 2 3 4 4 4 0 0 -1 -2 -3 -4 -5
'
' Su Mo Tu We Th Fr Sa Sa Fr Th We Tu Mo Su
' 0 1 2 3 4 5 5 0 -1 -2 -3 -4 -5 -5
'
' Sa Su Mo Tu We Th Fr Fr Th We Tu Mo Su Sa
' 0 0 1 2 3 4 5 0 -1 -2 -3 -4 -4 -4
'
' Fr Sa Su Mo Tu We Th Th We Tu Mo Su Sa Fr
' 0 0 0 1 2 3 4 0 -1 -2 -3 -3 -3 -4
'
' Execution time for finding working days of three years is about 4 ms.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-19. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function DateDiffWorkdays( _
ByVal Date1 As Date, _
ByVal Date2 As Date, _
Optional ByVal WorkOnHolidays As Boolean) _
As Long
Dim Holidays() As Date
Dim Diff As Long
Dim Sign As Long
Dim NextHoliday As Long
Dim LastHoliday As Long
Sign = Sgn(DateDiff("d", Date1, Date2))
If Sign <> 0 Then
If WorkOnHolidays = True Then
' Holidays are workdays.
Else
' Retrieve array with holidays between Date1 and Date2.
Holidays = GetHolidays(Date1, Date2, False) 'CBool(Sign < 0))
' Ignore error when using LBound and UBound on an unassigned array.
On Error Resume Next
NextHoliday = LBound(Holidays)
LastHoliday = UBound(Holidays)
' If Err.Number > 0 there are no holidays between Date1 and Date2.
If Err.Number > 0 Then
WorkOnHolidays = True
End If
On Error GoTo 0
End If
' Loop to sum up workdays.
Do Until DateDiff("d", Date1, Date2) = 0
Select Case Weekday(Date1)
Case vbSaturday, vbSunday
' Skip weekend.
Case Else
If WorkOnHolidays = False Then
' Check for holidays to skip.
If NextHoliday <= LastHoliday Then
' First, check if NextHoliday hasn't been advanced.
If NextHoliday < LastHoliday Then
If Sgn(DateDiff("d", Date1, Holidays(NextHoliday))) = -Sign Then
' Weekend hasn't advanced NextHoliday.
NextHoliday = NextHoliday + 1
End If
End If
' Then, check if Date1 has reached a holiday.
If DateDiff("d", Date1, Holidays(NextHoliday)) = 0 Then
' This Date1 hits a holiday.
' Subtract one day to neutralize the one
' being added at the end of the loop.
Diff = Diff - Sign
' Adjust to the next holiday to check.
NextHoliday = NextHoliday + 1
End If
End If
End If
Diff = Diff + Sign
End Select
' Advance Date1.
Date1 = DateAdd("d", Sign, Date1)
Loop
End If
DateDiffWorkdays = Diff
End Function
' Returns the holidays between Date1 and Date2.
' The holidays are returned as an array with the
' dates ordered ascending, optionally descending.
'
' The array is declared static to speed up
' repeated calls with identical date parameters.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-18. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function GetHolidays( _
ByVal Date1 As Date, _
ByVal Date2 As Date, _
Optional ByVal OrderDesc As Boolean) _
As Date()
' Constants for the arrays.
Const DimRecordCount As Long = 2
Const DimFieldOne As Long = 0
Static Date1Last As Date
Static Date2Last As Date
Static OrderLast As Boolean
Static DayRows As Variant
Static Days As Long
Dim rs As DAO.Recordset
' Cannot be declared Static.
Dim Holidays() As Date
If DateDiff("d", Date1, Date1Last) <> 0 Or _
DateDiff("d", Date2, Date2Last) <> 0 Or _
OrderDesc <> OrderLast Then
' Retrieve new range of holidays.
Set rs = DatesHoliday(Date1, Date2, OrderDesc)
' Save the current set of date parameters.
Date1Last = Date1
Date2Last = Date2
OrderLast = OrderDesc
Days = rs.RecordCount
If Days > 0 Then
' As repeated calls may happen, do a movefirst.
rs.MoveFirst
DayRows = rs.GetRows(Days)
' rs is now positioned at the last record.
End If
rs.Close
End If
If Days = 0 Then
' Leave Holidays() as an unassigned array.
Erase Holidays
Else
' Fill array to return.
ReDim Holidays(Days - 1)
For Days = LBound(DayRows, DimRecordCount) To UBound(DayRows, DimRecordCount)
Holidays(Days) = DayRows(DimFieldOne, Days)
Next
End If
Set rs = Nothing
GetHolidays = Holidays()
End Function
' Returns the holidays between Date1 and Date2.
' The holidays are returned as a recordset with the
' dates ordered ascending, optionally descending.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-18. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DatesHoliday( _
ByVal Date1 As Date, _
ByVal Date2 As Date, _
Optional ByVal ReverseOrder As Boolean) _
As DAO.Recordset
' The table that holds the holidays.
Const Table As String = "Holiday"
' The field of the table that holds the dates of the holidays.
Const Field As String = "Date"
Dim rs As DAO.Recordset
Dim SQL As String
Dim SqlDate1 As String
Dim SqlDate2 As String
Dim Order As String
SqlDate1 = Format(Date1, "\#yyyy\/mm\/dd\#")
SqlDate2 = Format(Date2, "\#yyyy\/mm\/dd\#")
ReverseOrder = ReverseOrder Xor (DateDiff("d", Date1, Date2) < 0)
Order = IIf(ReverseOrder, "Desc", "Asc")
SQL = "Select " & Field & " From " & Table & " " & _
"Where " & Field & " Between " & SqlDate1 & " And " & SqlDate2 & " " & _
"Order By 1 " & Order
Set rs = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)
Set DatesHoliday = rs
End Function
You'll see, that in its core it's nothing but a simple loop, which is so fast that attempts to optimise won't pay off for typical usage.
Maybe you try to use function networkdays
=NETWORKDAYS(start_date,end_date,holidays)
holidays is optional
For example, if you have the date January 4, 2016 (a Monday) in cell B4, and January 11, 2016 (also a Monday) in cell C4, this formula will return 6:
=NETWORKDAYS(B4,C4)
for VBA in ACCESS
Sub test()
Dim xl As Object
Set xl = CreateObject("Excel.Application")
BegDate = #4/11/2019#
EndDate = #6/11/2019#
result = xl.WorksheetFunction.NetworkDays(BegDate, EndDate) ' 44
Set xl = Nothing
End Sub
OR
this one
I have a date in cell A1 in text format - May 18
Using VBA, is it possible, to positively compare this value to the value in cell A2 - 01/05/2018 (UK date format)?
I've tried using the CDate function, but it does not return the correct value. For example, If the value in A1 was Nov 24, CDate reurns 24/11/2018.
So, what I want to do is :-
If A1 = May 18
AND A2 = 01/05/2018
THEN TRUE
You could use DATEVALUE:
=DATEVALUE("1 " & $A$1)=$A$2
Will return TRUE if 1st of the month in cell A1 is the same as the date in cell A2.
You can use an Excel formula:
=TEXT("18 May","dd-mm-yyyy")
Or in VBA:
Dim Dt As Date
Dt = CDate(Range("A1"))
Dim Compare As Boolean
Compare = Dt = Range("A2")
With VBA, consider:
Sub DateCompaison()
Dim s1 As String, s2 As String, d2 As Date
s1 = [A1].Text
s2 = [A2].Text
arry1 = Split(s1, " ")
arry2 = Split(s2, "/")
month1 = arry1(0)
year1 = "20" & arry1(1)
d2 = DateSerial(CInt(arry2(2)), CInt(arry2(1)), CInt(arry2(0)))
month2 = Format(d2, "mmmm")
year2 = CStr(Year(d2))
If month1 = month2 And year1 = year2 Then
MsgBox "the same"
Else
MsgBox "not the same"
End If
End Sub
I would like the following code to return Monday date only if dateadd hits Saturday and Sunday. Unfortunately, now it returns Monday at all times even though dateadd doesn't fall on a Saturday or Sunday date.
Is it anyway to improve this code in order to return Monday only when needed?
Private Sub Worksheet_Change(ByVal target As Range)
Dim d1 As Date, d2 As Date, d3 As Date
d1 = NextMonday(Date, 1)
d2 = NextMonday(Date, 7)
d3 = NextMonday(Date, 5)
If Not Intersect(target, Range("H3:H150")) Is Nothing Then
If target.Value = 7 Then
target.Offset(0, 1).Value = d2
ElseIf target.Value = 5 Then
target.Offset(0, 1).Value = d3
ElseIf target.Value = 1 Then
target.Offset(0, 1).Value = d1
Else
End If
End If
End Sub
Function NextMonday(dtDate As Date, lngDaysToAdd As Long)
Dim intDaysOffset As Integer
NextMonday = DateAdd("d", lngDaysToAdd, dtDate)
intDaysOffset = (7 - Weekday(NextMonday, vbMonday)) + 1
NextMonday = DateAdd("d", intDaysOffset, NextMonday)
End Function
Having found your "landing date", you can use this generic function to return the Monday should the date be a weekend day:
Public Function DateSkipWeekend( _
ByVal datDate As Date, _
Optional ByVal booReverse As Boolean) _
As Date
' Purpose: Calculate first working day equal to or following/preceding datDate.
' Assumes: 5 or 6 working days per week. Weekend is (Saturday and) Sunday.
' Limitation: Does not count for public holidays.
'
' May be freely used and distributed.
' 1999-07-03, Gustav Brock, Cactus Data ApS, Copenhagen
Const cintWorkdaysOfWeek As Integer = 5
Dim bytSunday As Byte
Dim bytWeekday As Byte
bytSunday = Weekday(vbSunday, vbMonday)
bytWeekday = Weekday(datDate, vbMonday)
If bytWeekday > cintWorkdaysOfWeek Then
' Weekend.
If booReverse = False Then
' Get following workday.
datDate = DateAdd("d", 1 + bytSunday - bytWeekday, datDate)
Else
' Get preceding workday.
datDate = DateAdd("d", cintWorkdaysOfWeek - bytWeekday, datDate)
End If
End If
DateSkipWeekend = datDate
End Function
And in your function:
Function NextMonday(dtDate As Date, lngDaysToAdd As Long)
NextMonday = DateSkipWeekend(DateAdd("d", lngDaysToAdd, dtDate))
End Function
Check the resulting day and set the return value accordingly. But of course, your function should be renamed, I suggest NextWorkday because you want to skip only weekend days.
Function NextWorkday(dtDate As Date, lngDaysToAdd As Long)
NextWorkday = dtDate + lngDaysToAdd
Select Case Weekday(NextWorkday, vbMonday)
Case 6: NextWorkday = NextWorkday + 2
Case 7: NextWorkday = NextWorkday + 1
End Select
End Function
I'm not sure why you are updating only for some values, but if you still want this checking, your code can be translated to this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> Columns("H").Column Then Exit Sub
Select Case Target.Value2
Case 1, 5, 7: Target.Offset(0, 1).value = NextWorkday(Date, Target.Value2)
End Select
End Sub
You could use the built-in Excel function Workday:
Function NextMonday(dtDate As Date, lngDaysToAdd As Long) As Date
NextMonday = Application.WorkDay(dtDate + lngDaysToAdd - 1, 1)
End Function
The subtraction of 1 from the future date is to allow one workday to be added. (Adding zero workdays to a date that is a Saturday/Sunday would return the Saturday/Sunday.)
(And, as A.S.H suggested, it would be a good idea to rename that Function as it doesn't return "next Monday".)
However, if I am reading your VBA code correctly, you may be able to just use WORKDAY in an Excel cell, e.g. in cell I3 use
=WORKDAY(TODAY()+H3-1,1)
I have an executable that when run takes an inputted date and then selects what date suffix is needed with it, however it is always defaulting to the case else.
when i have 02/04/2017 as format DD/MM/YYYY the result of the below case is 2th April instead of 2nd...
Could anyone enlighten me on the problem.
Dim Datewc As Date = Nothing
If CheckBox1.Checked Then
Datewc = TextBox1.Text
End If
'Determine date suffix
Dim datsuff As String = ""
Select Case CInt(Datewc.Day)
Case 1 Or 21 Or 31
datsuff = "st"
Case 2 Or 22
datsuff = "nd"
Case 3 Or 23
datsuff = "rd"
Case Else
datsuff = "th"
End Select
Parse you date
Dim dDate As DateTime =
DateTime.ParseExact(TextBox1.Text, "dd/MM/yyyy", CultureInfo.InvariantCulture)
Change your code a little, should work.
Day function returns integer, no need to Cast using CInt.
'Determine date suffix
Dim datsuff As String = ""
Select Case Datewc.Day
Case 1 , 21 , 31
datsuff = "st"
Case 2 , 22
datsuff = "nd"
Case 3 , 23
datsuff = "rd"
Case Else
datsuff = "th"
End Select
Explanation
Case 2 Or 22 means Case ((2 Or 22) ==true), It will be false hence going to else part.
Hope someone can help with this. I have an access 2010 DB. I want to calculate the current school year for a pupil. To do this I have the date of birth on the form and a blank bound text box called "NCY"
The following doesn't take into account when the year changes from December to January, it changes the school year when I don't want it to change it until September (School year runs September to August)
Private Sub yearGroup_GotFocus()
Dim nowDate As Date
Dim dob As Date
Dim dobMonth As Integer
Dim dobYear As Integer
Dim NCY As Integer
nowDate = Date
nowYear = year(nowDate)
dob = Me.dateOfBirth
dobMonth = Month(dob)
dobYear = year(dob)
NCY = nowYear - dobYear
If dobMonth > 8 Then
Me.yearGroup.Value = NCY - 6
Else
Me.yearGroup.Value = NCY - 5
End If
End Sub
In English I want something along the lines of;
If the current month of current year is >8 then increase the NCY by 1
unless the current year has changed by 1 and the month in that year is <9
Hope this makes sense.
Thank you in advance
I hardcoded the DOB on this one because I was practicing in Excel. This assumes the ch8ild is in grade 1 when he is 6 years old before August. Mostly in the USA we start Kindergarten at age five, and grade 1 at age 6. You can adjust accordingly.
Private Sub yearGroup_GotFocus2()
Dim nowDate As Date
Dim dob As Date
Dim dobMonth As Integer
Dim dobYear As Integer
Dim NCY As Integer
Dim currentlyInSchool As Boolean
Dim schoolYear As Long
Dim schoolGrade As Long
nowDate = Date
nowYear = Year(nowDate)
dob = DateValue("Feb 15, 2000")
dobMonth = Month(dob)
dobYear = Year(dob)
NCY = nowYear - dobYear
abc = 123
' First find out the current school year.
' School year runs from August to May
If Month(nowDate) <= 5 Then
schoolYear = Year(nowDate) - 1
Else
schoolYear = Year(nowDate)
End If
Debug.Print "School year: " & schoolYear & "/" & Mid(CStr(schoolYear + 1), 3, 2)
If Month(dob) < 8 Then
schoolGrade = 1
Else
schoolGrade = 0
End If
schoolGrade = schoolGrade + (schoolYear - (Year(dob) + 5))
Debug.Print "Pupil Grade: " & schoolGrade
End Sub