How to find date using day number of the year in VBA? - vba

Suppose If i enter 209. It has to give me Jul 28th.
I could get day number from the date but in reverse. Can someone help me with this?

May be this code will help you
Sub Test()
Dim x
x = 209
MsgBox DateAdd("d", x - 1, "2018/1/1")
End Sub

Just add the number of days to the last day of last year.
=209 +"12/31/2017"

The following
=DATE(2018,1,209)
You can format in different ways the date returned e.g.
=TEXT(DATE(2018,1,209),"Mmm dd yyyy")
VBA and UDF:
Option Explicit
Public Sub test()
Debug.Print GetDate(209)
End Sub
Public Function GetDate(ByVal daynumber As Long) As String
GetDate = Format$(DateSerial(Year(Date), 1, daynumber), "Mmm dd yyyy")
End Function

Related

Convert range to integer

In the following code, CalendarMonths is a range containing month names. endDate is also a range.
I need to translate those names into month numbers, however the following method using Month function returns "type mismatch" error (even if I skip CInt):
For Each CalendarMonth In CalendarMonths
If CInt(Month(CalendarMonth)) = CInt(Month(endDate)) Then
If you have a month as String and want to convert to Long:
Sub skjdffhs()
Dim s As String, n As Long
s = "January"
n = Month(CDate("1 " & s & " 2000"))
MsgBox n
End Sub
(this is for the US locale)

VBA Basics - Calling Function From a Sub

I want to write a Function Macro that calculates the days between two dates. It looks like I have that.
Function daysRem(today As Date, eoc As Date) As Integer
daysRem = Abs(DateDiff("d", today, eoc))
End Function
Now, I need to "Call" that function from a Sub to roughly estimate the number of weeks remaining. I'd like that to be in a message box. That's where I've hit about 2 hours of frustration. This has got to be simple, but I just can't figure out what to do.
Try this:
Private Sub DisplayDaysDiff()
Dim dtDate1 as Date
Dim dtDate2 as Date
dtDate1 =ThisWorkbook.Worksheets("Sheet1").Range("A2")
dtDate2=ThisWorkbook.Worksheets("Sheet1").Range("B2")
MsgBox "Days difference: " & CStr(daysRem(dtDate1, dtDate2)), vbInformation
End Sub
Call it from a button_click event
Sub Main
x = MyFunction(Param1)
End Sub
MyFunction(MyDate as Date)
MyFunction = DateDiff("ww", Date(), MyDate)
End Function
You assign the value to the function name. The inbuilt Date() function is todays date.
Functions return something. Subs don't. Macros ARE SUBS.
Functions return something.
So
Function Test
Test = 5
End Function
Sub Main
x = Test() + 5
End Sub
So x = 10.
Sub Main
Param1 = #2/2/2017#
Range("B4").Value = MyFunction(Param1)
End Sub
MyFunction(MyDate as Date)
MyFunction = DateDiff("ww", Date(), MyDate)
End Function
Date is both a data type and a function. One doesn't have brackets and one does.

Using Excel DateAdd Function

I want to use excel DateAdd function to add some days to a cell containing a persian/hijri calendar date. So, I've created a button and assigned a macro to it like :
Sub mydateaddfunction()
Dim FirstDate As Date
Dim Number As Integer
FirstDate = Sheets(3).Range("e13").Value
Number = Sheets(3).Range("b13").Value
Sheets(3).Range("e14").Value = DateAdd("d", Number, FirstDate)
End Sub
but unfortunately it throws an error
application defined or object-defined error
error coming from this line :
Sheets(3).Range("e14").Value = DateAdd("d", Number, FirstDate)
e13 cell contains the date, b13 contains the number of days I want to add to the e13 cell. so if e13 cell be something like :
1396/10/17
and b13 contains a number like 3, I want e14 to be:
1396/10/20
What I'm doing wrong?
In case of Excel 2016 Change your code to
Sub mydateaddfunction()
Dim FirstDate As Date
Dim Number As Integer
Dim rg As Range
Set rg = Union(Sheets(1).Range("E13"), Sheets(1).Range("E14"))
rg.NumberFormat = "[$-fa-IR,16]dd/mm/yyyy;#"
FirstDate = Sheets(1).Range("e13").Value
Number = Sheets(1).Range("b13").Value
Sheets(1).Range("e14").Value = DateAdd("d", Number, FirstDate)
End Sub
By default VBA uses the Gregorian Date Calendar. So I assume that you need to convert your Hijri Date to Gregorian Date and after adding the days to it convert the Gregorian Date back to the Hijri Date.
Please give this a try...
Sub mydateaddfunction()
Dim FirstDate As Date
Dim Number As Integer
Dim gDate As Date
FirstDate = HijriToGreg(Sheets(3).Range("e13").Value)
Number = Sheets(3).Range("b13").Value
gDate = DateAdd("d", Number, FirstDate)
Sheets(3).Range("e14").Value = GregToHijri(gDate)
End Sub
Function GregToHijri(dtGegDate As Date) As String
'Converts Gregorian date to a Hijri date
VBA.Calendar = vbCalHijri
GregToHijri = dtGegDate
VBA.Calendar = vbCalGreg
End Function
Function HijriToGreg(dtHijDate As String) As Date
'Converts Hijri date to a Gregorian date
VBA.Calendar = vbCalHijri
HijriToGreg = dtHijDate
VBA.Calendar = vbCalGreg
End Function
For those looking for a simple solution, they can use Excel existing function called "Workday" to add x number of days to a data.
WORKDAY(start_date, days, [holidays])

converting "mmm-yy" to "dd/mm/yyy"

Does anyone have any idea how to convert a date formatted "mmm-yy" (in a ComboBox)to "dd/mm/yyyy". I have tried:
Format(Me.ComboBox5.Value, "dd/mm/yyyy")
But, VBA's interpretation of this causes the month and year to become the day and month and the year is then taken as 2016. For example Mar-12 becomes 12/03/2016.
Thanks so much in advance
Function ChangeDate(strInput As String) As Date
Dim iYear, iMonth
iYear = CInt(Split(strInput, "-")(1))
iMonth = Month("01/" & Format(Split(strInput, "-")(0), "mmmm"))
ChangeDate= DateSerial(iYear, iMonth, 1)
End Function

Excel VBA Set Variable to Equal Values between Dates

In Excel using VBA, I need to set a variable to equal a list of all the dates between a start and end date (similar to equaling a range containing multiple values). The catch is only the start and end date are in a range, non of the values in between.
In SQL Server I've used the Sys.Columns table to generate a list of dates between two dates that are not actually stored on that table. Is there a way to do something similar here without having each date between the start and end date written somewhere? I googled for a couple hours and didn't find anything on how to do this.
What I'm attempting to do is have a variable I can do a For Each loop on. So for each date I will check if it exists in another worksheet, if it does nothing will happen, if it does not it will be added.
I've tried:
Dim DatesInSettings As Date
DatesInSettings = StartDate To EndDate
For Each Date In DatesInSettings
'Insert commands here
Next DatesInSetting
But that clearly isn't the answer. Help?
This searches Sheet2 for dates between the start date and end dates on Sheet1 - in cells A1 and B1:
Sub RunDates()
Dim StartDate As Date
Dim EndDate As Date
Dim i As Date
StartDate = Sheet1.Range("A1")
EndDate = Sheet1.Range("B1")
For i = StartDate To EndDate
If WorksheetFunction.CountIf(Sheet2.Range("A1:A5"), i) > 0 Then
Debug.Print i; "- date found"
Else
Debug.Print i; "- date not found"
End If
Next i
End Sub
The following subroutine calls a dictionary that will store all the dates between two given endpoints. Then it uses a simple existence comparison to check if the dates on your list is inside the dictionary's items. If it's not, it's going to print them out as not in the list.
Modify accordingly to suit your needs. ;)
CODE:
Sub GetListOfDates()
Dim StartDate As Date, EndDate As Date
Dim DictOfDates As Object, DateToCheck As Variant, ListOfDates As Variant
Dim Iter As Long
Set DictOfDates = CreateObject("Scripting.Dictionary")
StartDate = "12/31/2013"
EndDate = "01/15/2014"
For Iter = StartDate + 1 To EndDate - 1
With DictOfDates
If Not .Exists(Iter) Then
.Add Iter, Empty
End If
End With
Next Iter
'--Print them somewhere.
'Range("A1").Resize(DictOfDates.Count, 1).Value = Application.Transpose(DictOfDates.Keys)
ListOfDates = Range("B1:B15").Value
For Each DateToCheck In ListOfDates
If Not DictOfDates.Exists(DateToCheck) Then
Debug.Print Str(DateToCheck) + " is not in the list!" '--Or whatever action you want.
End If
Next DateToCheck
Set DictOfDates = Nothing
End Sub
Let us know if this helps. :)
I solved it with a vector.
I hope it helps
Sub Dates_Vector()
Public Dates() As Date
ReDim Dates(End_Dat - Start_Date)
For x = 0 To End_Dat - Start_Date
Dates(x) = Dat_Ini + x
Next x
For Each Date In Dates
'Insert commands here
Next Date
End Sub