futr_vision
asked on
How do I use a date range picker in Excel 2007 to autopopulate a table?
I want to be able to pick a start date and an end date using some type of date picker and have have Excel create a table row for each date.
1. How do I create the date picker or date range picker?
2. How do I get a table to create a row for each date?
1. How do I create the date picker or date range picker?
2. How do I get a table to create a row for each date?
ASKER
The link you provided dates back to an answer in 2006. I am running Excel 2007 and my menu items are completely different. If there a more recent explanation of how to add a date picker?
Can you also give me a better idea of how to accomplish the loop?
Can you also give me a better idea of how to accomplish the loop?
ASKER
Ok. I found this tutorial which pretty much answers my first question. Now i just need to get that loop to work,
http://danielcurran.com/instructions/insert-a-drop-down-calendar-menu-in-excel-choose-a-date/
http://danielcurran.com/instructions/insert-a-drop-down-calendar-menu-in-excel-choose-a-date/
I have included a very simple working script to show how the loop can be created.
It uses the DateDiff function to determine the number of days difference between the dates and then uses a for loop to iterate through each value
Michael
It uses the DateDiff function to determine the number of days difference between the dates and then uses a for loop to iterate through each value
Michael
Sub test()
Dim startDate As Date, finishDate As Date
Dim daydif As Integer, i As Integer
startDate = Range("C1").Value
finishDate = Range("C2").Value
daydif = DateDiff("d", startDate, finishDate)
For i = 0 To daydif
Range("A" & i + 1).Value = startDate + i
Next
End Sub
ASKER
This is going to be a real stupid question but I am brand new to macros. How do I implement this code?
First open the VBA Editor by selecting ALT+F11
Then right click on the left hand side and select Insert > Module
Copy and paste the code above into the module.
You can run the code from the editor by selecting the green Run Sub button in the toolbar.
I have commented the code to say what it is doing (A single quote tells VBA to treat the following text as comments and not code)
Remember a good trick to determine how to do something in VBA is to record a macro, perform the actions you want to automate and then have a look at the VBA that excel has created.
Let me know if you need more help with this
Michael
Then right click on the left hand side and select Insert > Module
Copy and paste the code above into the module.
You can run the code from the editor by selecting the green Run Sub button in the toolbar.
I have commented the code to say what it is doing (A single quote tells VBA to treat the following text as comments and not code)
Remember a good trick to determine how to do something in VBA is to record a macro, perform the actions you want to automate and then have a look at the VBA that excel has created.
Let me know if you need more help with this
Michael
' Declares the sub routine with its name
Sub test()
' Declaring the variables used in the sub.
Dim startDate As Date, finishDate As Date
Dim daydif As Integer, i As Integer
' Set startDate and finishDate to the values in cells C1 and C2
startDate = Range("C1").Value
finishDate = Range("C2").Value
' Set daydif to numbers difference between startDate and finishDate
daydif = DateDiff("d", startDate, finishDate)
' A loop starting at 0 and finishing at the value of datedif. IE i starts as 0 and
' at the start of each loop the value of i is incremented by until it reaches the
' value of datedif
For i = 0 To daydif
' Set the value of the cell in column A row i + 1 to the value of startDate + i
' Note - row is i + 1 as the loop starts at 0 but rows start at 1
Range("A" & i + 1).Value = startDate + i
Next
End Sub
ASKER
Thanks. So this works when you run it from the VBA Editor but how do you get this to work when a date picker is changed?
ASKER
Also, if the date range is reduced how do you remove the extra rows?
To determine when the datepicker value has changed you need to use the following event
Private Sub DTPicker1_Change()
this is placed into the sheet the date picker is on ie open VBA Editor and double click on the Sheet can can call the sub from there eg
Private Sub DTPicker1_Change()
Call test(DTPicker1.Value)
End Sub
When the number of rows is reduced you need to determine how many extra rows are there and delete them using something like
Rows("31:31").Delete Shift:=xlUp
I have included an example file which shows the above in action
At this point to assist you further it would be a lot easier to have an example file so I can see exactly what you want
Michael
Book1.xls
Private Sub DTPicker1_Change()
this is placed into the sheet the date picker is on ie open VBA Editor and double click on the Sheet can can call the sub from there eg
Private Sub DTPicker1_Change()
Call test(DTPicker1.Value)
End Sub
When the number of rows is reduced you need to determine how many extra rows are there and delete them using something like
Rows("31:31").Delete Shift:=xlUp
I have included an example file which shows the above in action
At this point to assist you further it would be a lot easier to have an example file so I can see exactly what you want
Michael
Book1.xls
ASKER
This is close but I need to be able to control the start date as well. Here is your file with the extra date control added. I've also added an Excel Table since I will need the table to auto fill rows with formulas as it expands.
Date-Picker.xlsm
Date-Picker.xlsm
Sorry for the delay I have been very busy
Here is a working example of what you asked for. It deletes the table and recreates it each time a date picker is changed
In the example file if the user attempts to input a start date lower than the end date (or vice versa) it will give an error and set the start date to the same value as the end date
Michael
Here is a working example of what you asked for. It deletes the table and recreates it each time a date picker is changed
In the example file if the user attempts to input a start date lower than the end date (or vice versa) it will give an error and set the start date to the same value as the end date
Michael
Sub updateDateTable()
Dim daydif As Integer, i As Integer, lastRow As Integer
'Determine the lastrow of data the difference in days between the datepicker values
lastRow = Range("A" & Rows.Count).End(xlUp).Row
daydif = DateDiff("d", Worksheets("Sheet1").DTPickerStart.Value, Worksheets("Sheet1").DTPickerEnd.Value)
'Delete the table currently in place
Range("A1:B" & lastRow).Delete Shift:=xlUp
' Set new header values
Range("A1").Value = "Date"
Range("B1").Value = "Month"
'Input new dates and month name
For i = 0 To daydif
Range("A" & i + 2).Value = Worksheets("Sheet1").DTPickerStart.Value + i
Range("B" & i + 2).Value = Format(Worksheets("Sheet1").DTPickerStart.Value + i, "mmmm")
Next
'Create new table for the new date range
ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1:B" & daydif + 2), , xlYes).Name = "DateTable"
ActiveSheet.ListObjects("DateTable").TableStyle = "TableStyleMedium9"
End Sub
Date-Picker.xlsm
I mean to say if the user enters a start date HIGHER than the end date
Michael
Michael
3rd time lucky
I had left a piece code behind that will cause the example above to fail at open. I have fixed this
Michael
Date-Picker.xlsm
I had left a piece code behind that will cause the example above to fail at open. I have fixed this
Michael
Date-Picker.xlsm
ASKER
Nice! This works well but I have two questions since there seems to be a good amount of extra code.
1. What do I need to change if I want to place the table somewhere else on the worksheet?
2. How do I create additional worksheets that basically duplicate this? It doesn't appear that simply making a copy of the worksheets works.
1. What do I need to change if I want to place the table somewhere else on the worksheet?
2. How do I create additional worksheets that basically duplicate this? It doesn't appear that simply making a copy of the worksheets works.
I have attached another version which as the column and row references made into global variables. This means you can change the location of the table simply by updating these variables. Note - It will not remove the existing table that needs to be done manually before running the new code
To place the code onto new sheets you need to copy the code found in the worksheet to the new sheet. If you open VBA editor (ALT+F11) and double click on sheet1 you will see the code that runs whenever the date picker is changed. This code needs to be copied into each worksheet that you want the macro to run on and then update the references to the date pickers with the names of the date pickers on the new sheet. Note In design mode mode if you select a date picker and then select properties you can change the name of the date picker
The attached example file has date pickers on two sheets and the updated code
To place the code onto new sheets you need to copy the code found in the worksheet to the new sheet. If you open VBA editor (ALT+F11) and double click on sheet1 you will see the code that runs whenever the date picker is changed. This code needs to be copied into each worksheet that you want the macro to run on and then update the references to the date pickers with the names of the date pickers on the new sheet. Note In design mode mode if you select a date picker and then select properties you can change the name of the date picker
The attached example file has date pickers on two sheets and the updated code
' Updated macro
' By changing these variables you will change the position of the table
Public Const dateCol As String = "A"
Public Const monthCol As String = "B"
Public Const headerRow As Long = 1
Sub updateDateTable()
Dim daydif As Integer, i As Integer, lastRow As Integer
'Determine the lastrow of data the difference in days between the datepicker values
lastRow = Range(dateCol & Rows.Count).End(xlUp).Row
daydif = DateDiff("d", Worksheets("Sheet1").DTPickerStart.Value, Worksheets("Sheet1").DTPickerEnd.Value)
'Delete the table currently in place
Range(dateCol & headerRow & ":" & monthCol & lastRow).Delete Shift:=xlUp
' Set new header values
Range(dateCol & headerRow).Value = "Date"
Range(monthCol & headerRow).Value = "Month"
'Input new dates and month name
For i = 0 To daydif
Range(dateCol & i + headerRow + 1).Value = ActiveSheet.DTPickerStart.Value + i
Range(monthCol & i + headerRow + 1).Value = Format(ActiveSheet.DTPickerStart.Value + i, "mmmm")
Next
'Create new table for the new date range
ActiveSheet.ListObjects.Add(xlSrcRange, _
Range(dateCol & headerRow & ":" & monthCol & daydif + 2), , xlYes).Name = "DateTable"
ActiveSheet.ListObjects("DateTable").TableStyle = "TableStyleMedium9"
End Su
' Code for date pickers on sheet 2. Note the date picker names have been updated.
Private Sub DTPickerEnd2_Closeup()
If DTPickerEnd2.Value < DTPickerStart2.Value Then
MsgBox "End date must be larger than the start date"
DTPickerEnd2.Value = DTPickerStart2.Value
End If
Call updateDateTable(DTPickerStart2.Value, DTPickerEnd2.Value)
End Sub
Private Sub DTPickerStart2_Closeup()
If DTPickerStart2.Value > DTPickerEnd2.Value Then
MsgBox "Start date must be lower than the end date"
DTPickerStart2.Value = DTPickerEnd2.Value
End If
Call updateDateTable(DTPickerStart2.Value, DTPickerEnd2.Value)
End Sub
Date-Picker.xlsm
ASKER
I think this works great! If I need to add additional columns is there an easy way to do that too?
To add additional columns you could add additional global variables and then update the following lines
Range(dateCol & headerRow & ":" & monthCol & lastRow).Delete Shift:=xlUp
ActiveSheet.ListObjects.Ad d(xlSrcRan ge, _
Range(dateCol & headerRow & ":" & monthCol & daydif + 2), , xlYes).Name = "DateTable
To include the new table range, ie replace monthCol with the variable for the new last column of the table
You would probably also want to include new headers and data by adding lines to these sections. eg
' Set new header values
Range(dateCol & headerRow).Value = "Date"
Range(monthCol & headerRow).Value = "Month"
Range(yearCol & headerRow).Value = "Year"
and
'Input new dates and month name
For i = 0 To daydif
Range(dateCol & i + headerRow + 1).Value = ActiveSheet.DTPickerStart. Value + i
Range(monthCol & i + headerRow + 1).Value = Format(ActiveSheet.DTPicke rStart.Val ue + i, "mmmm")
Range(yearCol & i + headerRow + 1).Value = Format(ActiveSheet.DTPicke rStart.Val ue + i, "yyyy")
Next
Michael
Range(dateCol & headerRow & ":" & monthCol & lastRow).Delete Shift:=xlUp
ActiveSheet.ListObjects.Ad
Range(dateCol & headerRow & ":" & monthCol & daydif + 2), , xlYes).Name = "DateTable
To include the new table range, ie replace monthCol with the variable for the new last column of the table
You would probably also want to include new headers and data by adding lines to these sections. eg
' Set new header values
Range(dateCol & headerRow).Value = "Date"
Range(monthCol & headerRow).Value = "Month"
Range(yearCol & headerRow).Value = "Year"
and
'Input new dates and month name
For i = 0 To daydif
Range(dateCol & i + headerRow + 1).Value = ActiveSheet.DTPickerStart.
Range(monthCol & i + headerRow + 1).Value = Format(ActiveSheet.DTPicke
Range(yearCol & i + headerRow + 1).Value = Format(ActiveSheet.DTPicke
Next
Michael
Here is the the update Table macro with an extra column so you see the changes that need to be made
Michael
Michael
' Updated macro
' By changing these variables you will change the position of the table
Public Const dateCol As String = "A"
Public Const monthCol As String = "B"
Public Const yearCol As String = "C"
Public Const headerRow As Long = 1
Sub updateDateTable()
Dim daydif As Integer, i As Integer, lastRow As Integer
'Determine the lastrow of data the difference in days between the datepicker values
lastRow = Range(dateCol & Rows.Count).End(xlUp).Row
daydif = DateDiff("d", Worksheets("Sheet1").DTPickerStart.Value, Worksheets("Sheet1").DTPickerEnd.Value)
'Delete the table currently in place
Range(dateCol & headerRow & ":" & yearCol & lastRow).Delete Shift:=xlUp
' Set new header values
Range(dateCol & headerRow).Value = "Date"
Range(monthCol & headerRow).Value = "Month"
Range(yearCol & headerRow).Value = "Year"
'Input new dates and month name
For i = 0 To daydif
Range(dateCol & i + headerRow + 1).Value = ActiveSheet.DTPickerStart.Value + i
Range(monthCol & i + headerRow + 1).Value = Format(ActiveSheet.DTPickerStart.Value + i, "mmmm")
Range(yearCol & i + headerRow + 1).Value = Format(ActiveSheet.DTPickerStart.Value + i, "yyyy")
Next
'Create new table for the new date range
ActiveSheet.ListObjects.Add(xlSrcRange, _
Range(dateCol & headerRow & ":" & yearCol & daydif + 2), , xlYes).Name = "DateTable"
ActiveSheet.ListObjects("DateTable").TableStyle = "TableStyleMedium9"
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
I'm going to close out this question since it was answered but I have an additional question
https://www.experts-exchange.com/questions/22041214/Date-picker.html?sfQueryTermInfo=1+10+30+date+picker
You can then use a loop to create the rows by determining the number of days difference with
DayDif = DateDiff("d", startDate, finishDate)