I have a form where the user will input the start and end date. With this date, I need to enter all the dates from start date to end date in another worksheet DailyData. I am using below code but somehow it's not working. The code is not giving any error as well.How to make it work
Sub day()
Dim MaxGain As Workbook
Dim Main As Worksheet
Dim DailyData As Worksheet
Dim StartDate As Date
Dim EndDate As Date
Dim i As Long
Set MaxGain = Excel.Workbooks("MaxGain.xlsm")
Set Main = MaxGain.Worksheets("Main")
Set DailyData = MaxGain.Worksheets("DailyData")
StartDate = Main.Range("B5").Value
EndDate = Main.Range("B6").Value
i = 1
For DateLooper = StartDate To EndDate
DailyData.Cells(i, "A") = DateLooper
i = i + 1
Next DateLooper
End Sub
Excel has few methods of creating series in the Home tab > Editing > Fill
Sub Day()
[DailyData!A1] = [Main!B5].Value
[DailyData!A:A].DataSeries Stop:=[Main!B6]
End Sub
https://msdn.microsoft.com/en-us/vba/excel-vba/articles/range-dataseries-method-excel
Sub day()
Dim MaxGain As Workbook
Dim Main As Worksheet
Dim DailyData As Worksheet
Dim StartDate As Date, EndDate As Date, newDate as date
Dim i As Long, DaysBetween as long
Set MaxGain = Excel.Workbooks("MaxGain.xlsm")
Set Main = MaxGain.Worksheets("Main")
Set DailyData = MaxGain.Worksheets("DailyData")
StartDate = Main.Range("B5").Value
EndDate = Main.Range("B6").Value
DaysBetween = DateDiff("d", StartDate, EndDate)
newDate = StartDate
for i = 1 to DaysBetween
DailyData.Cells(i, "A") = newDate
newDate = DateAdd ("d", 1, newDate)
next i
End Sub
You need to reference DateLooper as :
Dim DateLooper As Long
Then in your For Loop :
DailyData.Cells(i, "A") = StartDate + DateLooper
Related
I need help creating an array of dates between 2 dates. I am trying to export holidays from MS Project calendar using the Exceptions object. However, each Calendar.Exception isn't a single date. They can be defined as a range of dates (eg Christmas holidays).
Sub ArrayOfDates()
Dim StartDate As Date, EndDate As Date, aDates() As Date
StartDate = #1/1/2018#
EndDate = #1/31/2018#
'create array of dates inclusive of endpoints
If EndDate > StartDate Then
End If
End Sub
Thanks for all of the suggestions. I went with the approach that eliminated the array:
Sub ExportCalendarHolidays()
Dim calThisPrjCalendar As Calendar, excPeriod As Exception, OutputFileName As String, sOutputLine As String
Dim Period As Date
Set calThisPrjCalendar = ActiveProject.Calendar
OutputFileName = ActiveProject.Path & "\" & "Holidays_" & Format(Now(), "yyyy-mm-dd_hhmmss") & ".csv"
Open OutputFileName For Output As #1
For Each excPeriod In calThisPrjCalendar.Exceptions
For Period = excPeriod.Start To excPeriod.Finish
sOutputLine = Format(Period, "mm/dd/yyyy")
Print #1, sOutputLine
Next Period
Next
'Cleanup
Close #1
End Sub
The code below will create the Array including the start and end date. The lines marked as Debug can be deleted. The loop at the end is just to verify the dates.
Edit: Edited ending loop to look nicer.
Sub ArrayOfDates()
Dim StartDate As Date, EndDate As Date, aDates() As Date
Dim x As Long, y As Long, totalDates As Integer
StartDate = #1/1/2018#
EndDate = #1/31/2018#
DateLoop = StartDate
totalDates = DateDiff("d", StartDate, EndDate)
ReDim aDates(totalDates)
x = 0
Do While DateLoop <= EndDate
aDates(x) = DateLoop
Cells(x + 1, 1).Value = DateLoop ' Debug Line
DateLoop = DateAdd("d", 1, DateLoop)
x = x + 1
Loop
For y = 0 To UBound(aDates)
Cells(y + 1, 3).Value = aDates(y) ' Debug Line
Cells(y + 1, 4).Value = "Array Spot: " & y 'Debug Line
Next y
End Sub
To just get all the dates, you could do something like.
Dim dtDate as Date, dtStartDate as date, dtEndDate as Date
dtStartDate = #1/1/2018#
dtEndDate = #1/31/2018#
For dtDate = dtStartDate To dtEndDate
'code to do each date
Next dtDate
I am trying to write a script that searches a list of dates, and identifyies how long date gaps are. I'm new to VBA, and this may be completely wrong, but after referencing several sites, here is what I came up with:
Sub IdentifyGaps()
Dim startdate As Date 'first date in column
Dim enddate As Date 'last date in column
Dim ust As Date 'first date of unemployment
Dim i As Long
ust = ActiveCell.Offset(1, 0).Value
With Sheet6
startdate = [A1]
enddate = .Cells(.Rows.Count, "A").End(xlUp).Value
For i = startdate To enddate
If ust <> DateAdd("d", 1, i) Then
Sheet6.[C1].Value = DateDiff("d", i, ust)
End If
Next i
End With
End Sub
I'm not receiving an error, but the macro is not working properly. Right now, it's returning -43074 when it should be returning 15. Any help would be much appreciated!
Here is a screenshot of the data, with the lone date gap it should pick up.
Sub IdentifyGaps()
Dim ws As Worksheet
Dim Date1 As Long, Date2 As Long, Gap As Long, lRow As Long
Set ws = Sheet6
lRow = ws.Range("C" & Rows.Count).End(xlUp).Row
For x = 1 To ws.Range("A" & Rows.Count).End(xlUp).Row
Date1 = ws.Cells(x, 1).Value
Date2 = ws.Cells(x + 1, 1).Value
Gap = DateDiff("d", Date1, Date2)
If Gap > 1 Then
ws.Range("C" & lRow).Value = Gap
lRow = lRow + 1
End If
Next x
Looking at my calendar, I believe your expected result should actually be 17, not 15. This code will return the gap value as a Long value with which you can do whatever you want.
'Reads a column of dates and returns the length of the first gap found
Function IdentifyGaps() As Long
Dim StartDate As Date
Dim EndDate As Date
'This Variable is not needed for this solution, it is instead replaced by Gap
'Dim ust As Date
Dim Gap As Long
'Read cell values into an array for more efficient operation
Dim ReadArray() As Variant
ReadArray = Sheet6.Range("A1").CurrentRegion
Dim LastRow As Long
LastRow = UBound(ReadArray, 1)
StartDate = ReadArray(1, 1)
EndDate = ReadArray(LastRow, 1)
'ThisDate and PreviousDate are declared explicitly to highlight program flow
Dim Row As Long
Dim ThisDate As Date
Dim PreviousDate As Date
For Row = 2 To UBound(ReadArray, 1)
ThisDate = ReadArray(Row, 1)
PreviousDate = ReadArray(Row - 1, 1)
Gap = ThisDate - PreviousDate
If Gap > 1 Then Exit For
Gap = 0
Next Row
IdentifyGaps = Gap
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ProveIt()
Debug.Print IdentifyGaps
End Sub
My piece of code is like below
Dim num As Integer
Dim dblRandBetween As Double
Dim startDate As Date, endDate As Date
startDate = "1/1/1990"
endDate = "1/1/2012"
num = InputBox("How Many IC numbers need to be generated")
For i = 1 To num
Set curCell = Worksheets("Sheet1").Cells(i, 3)
dblRandBetween = WorksheetFunction.RandBetween(startDate, endDate)
ActiveCell.Value = dblRandBetween
ActiveCell.Value.NumberFormat = "d/m/yyyy"
ActiveCell.Offset(1, 0).Activate
Next i
Am hitting "Run time error: 438" : Object doesnt support this property or method.
Is this as simple as changing:
ActiveCell.Value.NumberFormat = "d/m/yyyy"
to
ActiveCell.NumberFormat = "d/m/yyyy"
As the numberformat must be applied to the active cell not value.
Maybe try the full edit as below:
Dim num As Integer
Dim dblRandBetween As Double
Dim startDate As Date, endDate As Date
startDate = "1/1/1990"
endDate = "1/1/2012"
num = InputBox("How Many IC numbers need to be generated")
For i = 1 To num
dblRandBetween = WorksheetFunction.RandBetween(startDate, endDate)
With Worksheets("Sheet1").Cells(i, 3)
.Value = dblRandBetween
.NumberFormat = "d/m/yyyy"
End With
Next i
I am a newbie in vba and I am trying to get in vba all dates between 2 dates, for example I will call the function with the parameters 01-01-2015 and 15-01-2015, and I will get in return an array with all the dates possibles, i.e :
01-01-2015
02-01-2015
03-01-2015
.....
15-01-2015
I didn't find the answer on the forums, so thanks in advance for your help.
you can simply convert the dated in long and make loop(+1) and get all dated between 2 dates(convert that to date again)
Sub Calling()
Dim test
test = getDates(#1/25/2015#, #2/5/2015#)
End Sub
Function getDates(ByVal StartDate As Date, ByVal EndDate As Date) As Variant
Dim varDates() As Date
Dim lngDateCounter As Long
ReDim varDates(1 To CLng(EndDate) - CLng(StartDate))
For lngDateCounter = LBound(varDates) To UBound(varDates)
varDates(lngDateCounter) = CDate(StartDate)
StartDate = CDate(CDbl(StartDate) + 1)
Next lngDateCounter
getDates = varDates
ClearMemory:
If IsArray(varDates) Then Erase varDates
lngDateCounter = Empty
End Function
Function to get all dates from given range
Function GetDatesRange(dateStart As Date, dateEnd As Date) As Collection
Dim dates As New Collection
Dim currentDate As Date
currentDate = dateStart
Do While currentDate <= dateEnd
dates.Add currentDate
currentDate = DateAdd("d", 1, currentDate)
Loop
Set GetDatesRange = dates
End Function
Sample usage
Dim dateStartCell as Range, dateEndCell as Range
Dim allDates as Collection
Dim currentDateSter as Variant
Dim currentDate as Date
Set dateStartCell = ActiveSheet.Cells(3, 3)
Set dateEndCell = ActiveSheet.Cells(3, 6)
Set allDates = GetDatesRange(dateStartCell.Value, dateEndCell.Value)
For Each currentDateSter In allDates
currentDate = CDate(currentDateSter)
'Do something with currentDate
Next currentDateSter
An array 'sn' containing all dates from 01-01-2015 to 15-01-2015.
Msgbox introduced to illustrate the result.
Sub M_snb()
sn = Evaluate("index(text(datevalue(""01-01-2015"")+row(1:" & DateDiff("d", CDate("01-01-2015"), CDate("15-01-2015")) & ")-1,""dd-mm-yyyy""),)")
MsgBox sn(1, 1) & vbLf & sn(2, 1) & sn(UBound(sn), 1)
End Sub
Maybe this.
Function udf_Array_of_Dates(dtSTART As Date, dtEND As Date, rDATEs As Range)
Dim dt() As Date, r As Range, d As Long
For Each r In rDATEs
If r.Value >= dtSTART And r.Value <= dtEND Then
d = d + 1
ReDim Preserve dt(1 To d)
dt(d) = r.Value
End If
Next r
udf_Array_of_Dates = dt
End Function
Proof & syntax:
If you just want to print the dates between two date in excel then my Suggestion is to you try below the code.
Sub DateFill()
Dim Start_Date As Date
Dim End_Date As Date
Dim Number_Of_Days As Integer
Start_Date = InputBox(prompt:="Enter the Start Date", Title:="Date Print", Default:="3/1/2013")
End_Date = InputBox(prompt:="Enter the End Date", Title:="Date Print", Default:="3/23/2013")
Range("A1").Value = Start_Date
'Range("B1").Value = End_Date
Range("A1").Select
Number_Of_Days = DateDiff("d", Start_Date, End_Date) ' Return Day
Number_Of_Days = Number_Of_Days + 1
'Range("C1").Formula = "=DATEDIF(A1, B1, ""D"") "
Selection.AutoFill Destination:=Range("A1:A" & Number_Of_Days), Type:=xlFillDefault
Range("A1:A" & Number_Of_Days).Select
End Sub
Here you have avoid the use of Loop that save the execution time.
Previously I found some VBA code done by Andy Brown that generates a list and makes each date the first or 15th for another user. I have tried to adjust this code to my needs but I'm struggling. Currently the code, once run, is just putting in the same date over and over and I have to end Excel.
Sub GenerateDates()
Dim FirstDate As Date
Dim LastDate As Date
Dim NextDate As Date
FirstDate = Range("A1").Value
LastDate = Range("a2").Value
NextDate = FirstDate
Range("B1").Select
Do Until NextDate >= LastDate
ActiveCell.Value = NextDate
ActiveCell.Offset(1, 0).Select
If Day(NextDate) = 1 Then
NextDate = DateAdd("d", NextDate, 14)
Else
NextDate = DateAdd("d", NextDate, 20)
NextDate = DateSerial(Year(NextDate), Month(NextDate), 1)
End If
Loop
Previous code I based my model upon is listed above and my, most likely terrible code, is below:
Sub GenerateDates()
Dim FirstDate As Date
Dim LastDate As Date
Dim NextDate As Date
FirstDate = Range("startdate").Value
LastDate = Range("enddate").Value
NextDate = FirstDate
Range("tripdays").Select
'selection of columns within one row
Do Until NextDate >= LastDate
ActiveCell.Value = NextDate
ActiveCell.Offset(1, 0).Select
If Day(NextDate) = 1 Then
NextDate = DateAdd("d", NextDate, 14)
End If
Loop
End Sub
What I need instead is to generate every date between the given start and end dates, instead of just the 15th and 1st. How is this done?
EDIT:
This is apparently what you need, as discussed in comments.
Sub GenerateDates()
Dim FirstDate As Date
Dim LastDate As Date
Dim NextDate As Date
FirstDate = Range("startdate").Value
LastDate = Range("enddate").Value
NextDate = FirstDate
Range("tripdays").Select
'selection of columns within one row
Do Until NextDate > LastDate
ActiveCell.Value = NextDate
ActiveCell.Offset(1, 0).Select
NextDate = NextDate + 1
Loop
End Sub
Alternatively, a For loop would do just as well.
Screenshot:
FURTHER EDIT:
Horizontal version, as requested.
Sub GenerateDatesH()
Dim FirstDate As Date
Dim LastDate As Date
Dim NextDate As Date
Dim DateOffset As Range
Dim DateIter As Date
FirstDate = Range("startdate").Value
LastDate = Range("enddate").Value
Set DateOffset = Range("tripdays")
For DateIter = FirstDate To LastDate
DateOffset.Value = DateIter
Set DateOffset = DateOffset.Offset(0, 1)
Next DateIter
End Sub
Screenshot:
Note: I've also fixed the vertical version to stop at the end date provided.
Avoid using select in code it is very inefficient :)
Sub p()
Dim FirstDate As Date
Dim LastDate As Date
Dim NextDate As Date
Dim r As Long
FirstDate = Range("A1").Value
LastDate = Range("a2").Value
r = 1
Do
FirstDate = FirstDate + 1
Cells(r, 2) = FirstDate
r = r + 1
Loop Until FirstDate = LastDate
End Sub
to do it in a row replace cells(r,2) by cells(1, r) and start r=2