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])
Related
So the titles a bit of a mess but im trying to do the following:
I have a range of cells from Q8:Q12, T8:T12, Q16:Q20 and T16:T20
Im trying to have these cells populate with the date for each friday of this current month. Essentially, using July (The current month) it would look something like this:
Q8/T8 = 06/07
Q9/T9 = 13/07
Q10/T10 = 20/07
Q11/T11 = 27/07
Q12/T12 = -
The reason Q/T12 would be blank is to handle months of the year that have 5 fridays in them rather than 4. Its kind of a way of error handling.
I have a cell that currently tracks the month within the Cell A9 and the formula looks like this:
=TEXT(NOW(),"mmmm")
Im not quite sure how to handle this logically really. Either VBA or a Formula would do in my eyes.
Ideally, because i have a different sheet for every month July, August etc. The formula above changes depending on what month it is currently. I would need to convert the Formula/VBA script from cells Q8:Q12 OR A9 into a value AFTER populating the date range cells Q8:Q12.
Anyone have any ideas. Im sorry its a bit of a messy question
excel-formula
Put this in the first cell and copy down 5
=IFERROR(AGGREGATE(15,6,ROW(INDEX(A:A,EOMONTH(TODAY(),-1)+1):INDEX(A:A,EOMONTH(TODAY(),0)))/(WEEKDAY(ROW(INDEX(A:A,EOMONTH(TODAY(),-1)+1):INDEX(A:A,EOMONTH(TODAY(),0))),1)=6),ROW(1:1)),"-")
Then format to your specifications.
There are probably more elegant formulas but this is what came to mind.
Here is a macro version without needing a date value in Range("A9")...
Dim SoM As Date
Dim EoM As Date
Dim rw As Long
SoM = DateSerial(Year(Now), Month(Now) + 0, 1)
EoM = DateSerial(Year(Now), Month(Now) + 1, 0)
rw = 8
While SoM < EoM
If Weekday(SoM) = vbFriday Then
Cells(rw, 17).Value = SoM
Cells(rw, 17).NumberFormat = "m/d/yyyy"
rw = rw + 1
End If
SoM = SoM + 1
Wend
I made a user defined function that works with any date range, then show how it could be applied to this example with a few formulas. This would account for year to year transitions.
Function DAYOFWEEKFREQUENCY(ByVal dayOfWeekType As String, ByVal startDate As String, ByVal endDate As String) As Long
Dim myStartDate As Date
myStartDate = CDate(startDate)
Dim myEndDate As Date
myEndDate = CDate(endDate)
Dim includeStartDate As Long
includeStartDate = 1
Dim daysBetweenDatesInclusive As Long
daysBetweenDatesInclusive = Application.WorksheetFunction.Days(endDate, startDate) + includeStartDate
Dim vbStartDay As Long
vbStartDay = Weekday(startDate)
Dim dateCheckedIncremented As Date
dateCheckedIncremented = myStartDate
For dayCounter = 1 To daysBetweenDatesInclusive
If Weekday(dateIncrementedChecked) = dayOfWeekType Then
DAYOFWEEKFREQUENCY = DAYOFWEEKFREQUENCY + 1
End If
dateIncrementedChecked = DateAdd("d", 1, dateIncrementedChecked)
Next
End Function
How would I make my application do an event when there is a certain date? I can't seem to find something that works. Year doesn't matter, just day and month is all I need.
Since day and month is all you want to match on:
Dim myDate As Date = Date.Now
Dim someMonth As Integer = 4
Dim someDay As Integer = 13
If myDate.Month = someMonth AndAlso myDate.Day = someDay Then
... month and day are matched
End If
Use IsDate....
If IsDate(MyDate) Then.....
Update various ways of defining date
'DateTime constructor: parameters year, month, day, hour, min, sec
Dim MyDate1 As New Date(2012, 12, 10, 12, 0, 0)
'initializes a new DateTime value
Dim MyDate2 As Date = #12/10/2012 12:00:52 AM#
'using properties
Dim MyDate3 As Date = Date.Now
Dim MyDate4 As Date = Date.UtcNow
Dim MyDate5 As Date = Date.Today
Try something like this:
Dim thisDate As Date = New Date(2014, 4, 13) ' Assuming this is provided
Dim certainDate As Date = New Date(2013, 4, 13) ' Assuming this is provided
If thisDate = New Date(thisDate.Date.Year, certainDate.Month, certainDate.Day) Then
Debug.Print("dates equal excluding year")
Else
Debug.Print("dates UNequal excluding year")
End If
Rememebr, this will always create a new date object for comparison but it works.
Hope it helps!
I am currently programming a new Windows Phone Application and within this app i want the user to be able to find the hex date for any date of their choice. For this reason i am letting the user use a date picker to choose their desired date. Before i included the date picker i was allowing the user to get the hex date for today's date by using the following code:
ReverseString = 365 - DateTime.Today.DayOfYear
txtReverseJulian.Text = ReverseString.PadLeft(3, "0")
However now i can't use the DateTime function because i am letting them choose a date from the date picker, how can i change this code so that it will work?
Thank you
I am guessing at what you are trying to do... Could you provide clarification?
Dim foo As DateTime = New DateTime(DateTime.Today.Year, 12, 31) 'last day of the current year
Dim ldoy As Integer = foo.DayOfYear 'number of days in year
Dim dr As Integer = ldoy - DateTime.Today.DayOfYear 'number of days until end of year
Using a DatePicker
Dim foo As DateTime = New DateTime(aDatePicker.Value.Year, 12, 31) 'last day of the current year
Dim ldoy As Integer = foo.DayOfYear 'number of days in year
Dim dr As Integer = ldoy - aDatePicker.Value.DayOfYear 'number of days until end of year
This may help you
//Here is event fire when datepicker value will be change
ValueChanged="DatePicker_ValueChanged"
Private Sub DatePicker_ValueChanged(sender As Object, e As DateTimeValueChangedEventArgs)
ReverseString = e.NewDateTime.Value.ToString()
End Sub
txtReverseJulian.Text = ReverseString.PadLeft(3, "0")
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
i try loop while with datetime each on weekly in VB.NET 2008.
This Code
Private Sub Button1_Click()....
'Select DateTime
Dim strDate As Date = dateTimePicker.Value.ToString("yyyy-MM-dd")
'one week (+7)
Dim strDateWeek As String = DateAdd("d", +7, dateTimePicker.Value.ToString("yyyy-MM-dd"))
'DateCurrent
Dim strDateNow As String = DateAdd("d", 0, Now.ToLongDateString())
'While strDate < strDateNow
'ListBox1.Items.Add(strDateWeek)
'End While
ListBox1.Items.Add(strDateWeek)
End Sub
Example
I select on datetimepicker at "04/02/2013"
Output now: 11/02/2013
But I need Output each on weekly
11/02/2013
18/02/2013
25/02/2013 >>> To Current Week
I try loop While, But don't work.
Thanks you for your time. :)
You could do a while loop until the datetime is greater than today?
You want to use DateTime rather than Date, so you can compare to a DateTime.Now
You want to set your actual DatePicker value to a variable, else it will always be the same and you will just get an infinite loop.
Dim datePickerValue As DateTime = DateTimePicker.Value
Dim strDate As Date = DateTimePicker.Value.ToString("yyyy-MM-dd")
Dim strDateWeek As String
Dim strDateNow As String = DateAdd("d", 0, Now.ToLongDateString())
While datePickerValue < DateTime.Now()
strDateWeek = DateAdd("d", +7, datePickerValue.ToString("yyyy-MM-dd"))
datePickerValue = DateAdd("d", +7, datePickerValue.ToString("yyyy-MM-dd"))
ListBox1.Items.Add(strDateWeek)
End While
Just done it on my VS using your naming conventions and this works fine for me
It's been a long time since I didn't have used VB, but maybe I can help?
In your code, using while could be a wrong choice perhaps you could use a for with a break instead.
for I = 1 to 10
Dim strDateWeek As String = DateAdd("d", +7 * i, dateTimePicker.Value.ToString("yyyy-MM-dd"))
.
.
.
or
while(...)
I += 1
Dim strDateWeek As String = DateAdd("d", +7 * i, dateTimePicker.Value.ToString("yyyy-MM-dd"))
Hope that helps.
Try this:
Dim dtAux As Date = dateTimePicker.Value
Dim dtEnd As Date = Date.Today.AddDays(7 - dt.DayOfWeek)
While dtAux <= dtEnd
ListBox1.Items.Add(dtAux.ToString("yyyy-MM-dd"))
dtAux = dtAux.AddDays(7)
End While
The date dtEnd is the last day of the current week, if you want the loop to stop on the current date simply change the while condition to:
While dtAux <= Date.Today