Link to home
Start Free TrialLog in
Avatar of futr_vision
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?
Avatar of Michael Fowler
Michael Fowler
Flag of Australia image

For a date picker have a look at this link
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)




Avatar of futr_vision
futr_vision

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?
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/
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
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

Open in new window

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

' 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

Open in new window

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?
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
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
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
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

Open in new window

Date-Picker.xlsm
I mean to say if the user enters a start date HIGHER than the end date

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
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.
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


' 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

Open in new window

' 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

Open in new window

Date-Picker.xlsm
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.Add(xlSrcRange, _
         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.DTPickerStart.Value + i, "mmmm")
      Range(yearCol & i + headerRow + 1).Value = Format(ActiveSheet.DTPickerStart.Value + i, "yyyy")
   Next


Michael
Here is the the update Table macro with an extra column so you see the changes that need to be made

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

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Michael Fowler
Michael Fowler
Flag of Australia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
I'm going to close out this question since it was answered but I have an additional question