Extract years between two dates

K

koolwaters

Active Member
Joined
May 16, 2007
Messages
403
Hi,

I need to extract the years between two dates.

For example:

Start Date 2010-09-07
End Date 2014-08-30

The number of years between the Start Date and End Date are four.

As part of my query result, I need to see only the years between these two dates. So I would see,

2011 2012 2013 2014

If I have
Start Date 2010-09-07
End Date 2013-08-30

I need to see 2011 2012 2013

I hope that someone can assist.

Thanks in advance.
 
Sort by date Sort by votes
You can use the DateDif function to work out the number of years between 2 dates.

However getting the years in the format you want will be more tricky.

You could try using a cross-tab query and you wouldn't even need any expression to get the years.

All you would need to do would be to use the field with the date for column headers and group them by year.

The crosstab query wizard should do that for you if you select the correct options.

You might need to use more than one query to get exactly what you want, specifically the fields like Name, Dept, Discipline etc.

Anyway you should start by doing the crosstab and work from there.
 
Upvote 0

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
In your report I would put fields based on those columns from your query except for those that are the year columns. The year columns I would use an unbound textbox and set their control source to a DSum to count the amounts you want (or DCount whichever works better).

hth,

Rich
 
Upvote 0
Hi Michelle,

the only way I can think of is to create a temp table for the forecast.
I assembled a routine which creates a temporary table with the years projected as columns. The only thing I'm not sure about, is the first year where the amount occurs. I red your postings but it's not clear if for example the start date is 1-1-2010 and the amount is 100, you want this amount projected in the 2010 column for the first time, or in the 2011 column for the first time.
For now I assumed that the first year is the year of the start date, but this can be changed easily within the code. Further I made some assumptions regarding your field and table names, so please take a close look to see if the names correspond with reality in your db.

Paste the next code into a new module (mind the option settings, probably they are already on the new module's header) and run the sub CreateTempTable.

Code: 
Option Compare Database
Option Explicit
Public Function SQL_ABSYears() As String
Const sTableName As String = "Application"
SQL_ABSYears = "SELECT Min(StartDate) AS FirstStartDate, Max(EndDate) AS LastEndDate " _
             & "FROM " & sTableName
End Function
Public Function SQL_Application() As String
SQL_Application = "Select * from Application"
End Function
Public Sub CreateTempTable()
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim tdf As DAO.TableDef
Dim sSQL As String
Const sTempTableName As String = "tempForeCast"
Dim sYears() As String
Dim sYearFlds As String
Dim iFYear As Integer
Dim iLYear As Integer
Dim iCnt As Integer
Dim sAmounts() As String
Dim sAmount As String
Set dbs = CurrentDb
'Delete temptable if exists
For Each tdf In dbs.TableDefs
    If tdf.Name = sTempTableName Then dbs.TableDefs.Delete sTempTableName
Next tdf
'Fetch the absolute first date and last date
Set rs = dbs.OpenRecordset(SQL_ABSYears)
With rs
    If Not .EOF And Not .BOF Then
        .MoveFirst
        iFYear = Year(.Fields("FirstStartDate").Value)
        iLYear = Year(.Fields("LastEndDate").Value)
    Else
        MsgBox "No data found", vbExclamation
        Exit Sub
    End If
    .Close
End With
'Create array holding all years between startdate and enddate
'
For iCnt = 0 To iLYear - iFYear '- 1
    ReDim Preserve sYears(iCnt)
    sYears(iCnt) = (iFYear + iCnt) & " Double"
Next iCnt
'Join years for create table sql
sYearFlds = Join(sYears, ", ")
sYearFlds = "ApplicationID Long, ProgramID Long, DisciplineID Long, EmployeeID Long, StartDate DateTime, EndDate DateTime, AmountApproved Double, " & sYearFlds
'create the temptable and index
sSQL = "Create Table " & sTempTableName & " (" & sYearFlds & ")"
dbs.Execute sSQL
sSQL = "CREATE UNIQUE INDEX [PrimaryKey] ON " & sTempTableName & " ([ApplicationID])  WITH PRIMARY DISALLOW NULL "
dbs.Execute sSQL
'Section to append data from Application to forecast
Set rs = dbs.OpenRecordset(SQL_Application)
With rs
    .MoveFirst
    Do Until .EOF
 
        'First determine the years to forecast
        sYearFlds = vbNullString
        ReDim sYears(0)
        ReDim sAmounts(0)
        iFYear = Year(.Fields("StartDate").Value)
        iLYear = Year(.Fields("EndDate").Value)
        'create array for years to append
        For iCnt = 0 To iLYear - iFYear '- 1
            ReDim Preserve sYears(iCnt)
            ReDim Preserve sAmounts(iCnt)
            sYears(iCnt) = (iFYear + iCnt)
            sAmounts(iCnt) = .Fields("AmountApproved").Value
        Next iCnt
        sYearFlds = Join(sYears, ", ")
        sAmount = Join(sAmounts, ", ")
        'construct the insert statment
        sSQL = "Insert Into " & sTempTableName & "(ApplicationID, ProgramID, DisciplineID, EmployeeID, StartDate, EndDate, AmountApproved, " & sYearFlds & ")" _
             & "Values (" & .Fields("ApplicationID").Value & ", " & .Fields("ProgramID").Value & ", " & .Fields("DisciplineID").Value & ", " & .Fields("EmployeeID").Value & ", #" & .Fields("StartDate").Value & "#, #" & .Fields("EndDate").Value & "#, " & .Fields("AmountApproved").Value & ", " & sAmount & ")"
        'insert values into temptable
        dbs.Execute sSQL
    .MoveNext
    Loop
End With
End Sub
 
Upvote 0
Please use this code, I made a mistake in the previous post

Code: 
Option Compare Database
Option Explicit
Public Function SQL_ABSYears() As String
Const sTableName As String = "Application"
SQL_ABSYears = "SELECT Min(StartDate) AS FirstStartDate, Max(EndDate) AS LastEndDate " _
             & "FROM " & sTableName
End Function
Public Function SQL_Application() As String
SQL_Application = "Select * from Application"
End Function
Public Sub CreateTempTable()
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim tdf As DAO.TableDef
Dim sSQL As String
Const sTempTableName As String = "tempForeCast"
Dim sYears() As String
Dim sYearFlds As String
Dim iFYear As Integer
Dim iLYear As Integer
Dim iCnt As Integer
Dim sAmounts() As String
Dim sAmount As String
Set dbs = CurrentDb
'Delete temptable if exists
For Each tdf In dbs.TableDefs
    If tdf.Name = sTempTableName Then dbs.TableDefs.Delete sTempTableName
Next tdf
'Fetch the absolute first date and last date
Set rs = dbs.OpenRecordset(SQL_ABSYears)
With rs
    If Not .EOF And Not .BOF Then
        .MoveFirst
        iFYear = Year(.Fields("FirstStartDate").Value)
        iLYear = Year(.Fields("LastEndDate").Value)
    Else
        MsgBox "No data found", vbExclamation
        Exit Sub
    End If
    .Close
End With
'Create array holding all years between startdate and enddate
'
For iCnt = 0 To iLYear - iFYear '- 1
    ReDim Preserve sYears(iCnt)
    sYears(iCnt) = (iFYear + iCnt) & " Double"
Next iCnt
'Join years for create table sql
sYearFlds = Join(sYears, ", ")
sYearFlds = "ApplicationID Long, ProgramID Long, DisciplineID Long, EmployeeID Long, StartDate DateTime, EndDate DateTime, AmountApproved Double, " & sYearFlds
'create the temptable and index
sSQL = "Create Table " & sTempTableName & " (" & sYearFlds & ")"
dbs.Execute sSQL
sSQL = "CREATE UNIQUE INDEX [PrimaryKey] ON " & sTempTableName & " ([ApplicationID])  WITH PRIMARY DISALLOW NULL "
dbs.Execute sSQL
'Section to append data from Application to forecast
Set rs = dbs.OpenRecordset(SQL_Application)
With rs
    .MoveFirst
    Do Until .EOF
    
        'First determine the years to forecast
        sYearFlds = vbNullString
        ReDim sYears(0)
        ReDim sAmounts(0)
        iFYear = Year(.Fields("StartDate").Value)
        iLYear = Year(.Fields("EndDate").Value)
        'create array for years to append
        For iCnt = 0 To iLYear - iFYear '- 1
            ReDim Preserve sYears(iCnt)
            ReDim Preserve sAmounts(iCnt)
            sYears(iCnt) = (iFYear + iCnt)
            sAmounts(iCnt) = "'" & .Fields("AmountApproved").Value & "'"
        Next iCnt
        sYearFlds = Join(sYears, ", ")
        sAmount = Join(sAmounts, ", ")
        'construct the insert statment
        sSQL = "Insert Into " & sTempTableName & "(ApplicationID, ProgramID, DisciplineID, EmployeeID, StartDate, EndDate, AmountApproved, " & sYearFlds & ")" _
             & "Values (" & .Fields("ApplicationID").Value & ", " & .Fields("ProgramID").Value & ", " & .Fields("DisciplineID").Value & ", " & .Fields("EmployeeID").Value & ", #" & .Fields("StartDate").Value & "#, #" & .Fields("EndDate").Value & "#, '" & .Fields("AmountApproved").Value & "', " & sAmount & ")"
        'insert values into temptable
        dbs.Execute sSQL
    .MoveNext
    Loop
End With
End Sub
 
Upvote 0
Hi Kreszch68,

Thanks very much for your reply.

The funds are disbursed from the following year so if the Start Date is 01-01-2010, the first payment is made in 2011.

Your code worked to some extent but the approved amount is not correct.

The Amount Approved is divided by the number of years of study. For example:

If an employee is doing an undergrad, starting on 01-Feb-11 and ending on 01-Dec-15 and receiving $8,000.00 in assistance, they will receive $2,000.00 in 2012, $2,000.00 in 2013, $2,000.00 in 2014 and the last $2,000.00 in 2015.

So essentially, disbursements are made after the first year the study starts and the Amount Approved is divided by the duration of study and equal amounts are paid each year.

I hope that is clearer and you are also able to assist with this portion.

Thanks very much for taking the time to help.

the years between the start date and end date of the course of study as column headers and the amount granted divided by the number of years for each year.
 
Upvote 0
Ignore the last line in the previous post. That was entered in error.

I also need to see the text " - Amt in (US$)" as the column headers for the years so each year should have 2012 - Amt in (US$) 2013 - Amt in (US$) 2014 - Amt in (US$) , etc. Since the years will be dynamic, I am not quite sure how to achieve this.
 
Upvote 0
Hi Michelle,

try it again please, it seems ok now to me.

Johan

Code: 
Option Compare Database
Option Explicit
Public Function SQL_ABSYears() As String
Const sTableName As String = "Application"
SQL_ABSYears = "SELECT Min(StartDate) AS FirstStartDate, Max(EndDate) AS LastEndDate " _
             & "FROM " & sTableName
End Function
Public Function SQL_Application() As String
SQL_Application = "Select * from Application"
End Function
Public Sub CreateTempTable()
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim tdf As DAO.TableDef
Dim sSQL As String
Const sTempTableName As String = "tempForeCast"
Dim sYears() As String
Dim sYearFlds As String
Dim iFYear As Integer
Dim iLYear As Integer
Dim iCnt As Integer
Dim sAmounts() As String
Dim sAmount As String
Set dbs = CurrentDb
'Delete temptable if exists
For Each tdf In dbs.TableDefs
    If tdf.Name = sTempTableName Then dbs.TableDefs.Delete sTempTableName
Next tdf
'Fetch the absolute first date and last date
Set rs = dbs.OpenRecordset(SQL_ABSYears)
With rs
    If Not .EOF And Not .BOF Then
        .MoveFirst
        iFYear = Year(.Fields("FirstStartDate").Value) + 1
        iLYear = Year(.Fields("LastEndDate").Value)
    Else
        MsgBox "No data found", vbExclamation
        Exit Sub
    End If
    .Close
End With
'Create array holding all years between startdate and enddate
'- Amt in (US$)"
For iCnt = 0 To iLYear - iFYear '- 1
    ReDim Preserve sYears(iCnt)
    sYears(iCnt) = "[" & (iFYear + iCnt) & "- Amt in (US$)] Double"
Next iCnt
'Join years for create table sql
sYearFlds = Join(sYears, ", ")
sYearFlds = "ApplicationID Long, ProgramID Long, DisciplineID Long, EmployeeID Long, StartDate DateTime, EndDate DateTime, AmountApproved Double, " & sYearFlds
'create the temptable and index
sSQL = "Create Table " & sTempTableName & " (" & sYearFlds & ")"
dbs.Execute sSQL
sSQL = "CREATE UNIQUE INDEX [PrimaryKey] ON " & sTempTableName & " ([ApplicationID])  WITH PRIMARY DISALLOW NULL "
dbs.Execute sSQL
'Section to append data from Application to forecast
Set rs = dbs.OpenRecordset(SQL_Application)
With rs
    .MoveFirst
    Do Until .EOF
 
        'First determine the years to forecast
        sYearFlds = vbNullString
        ReDim sYears(0)
        ReDim sAmounts(0)
        iFYear = Year(.Fields("StartDate").Value) + 1
        iLYear = Year(.Fields("EndDate").Value)
        'create array for years to append
        For iCnt = 0 To iLYear - iFYear '- 1
            ReDim Preserve sYears(iCnt)
            ReDim Preserve sAmounts(iCnt)
            sYears(iCnt) = "[" & (iFYear + iCnt) & "- Amt in (US$)]"
            sAmounts(iCnt) = "'" & .Fields("AmountApproved").Value / (iLYear - (iFYear - 1)) & "'"
        Next iCnt
        sYearFlds = Join(sYears, ", ")
        sAmount = Join(sAmounts, ", ")
        'construct the insert statment
        sSQL = "Insert Into " & sTempTableName & "(ApplicationID, ProgramID, DisciplineID, EmployeeID, StartDate, EndDate, AmountApproved, " & sYearFlds & ")" _
             & "Values (" & .Fields("ApplicationID").Value & ", " & .Fields("ProgramID").Value & ", " & .Fields("DisciplineID").Value & ", " & .Fields("EmployeeID").Value & ", #" & .Fields("StartDate").Value & "#, #" & .Fields("EndDate").Value & "#, '" & .Fields("AmountApproved").Value & "', " & sAmount & ")"
        'insert values into temptable
        dbs.Execute sSQL
    .MoveNext
    Loop
End With
End Sub
 
Upvote 0
Ok, once again a little typo, so please use this instead

Code: 
Option Compare Database
Option Explicit
Public Function SQL_ABSYears() As String
Const sTableName As String = "Application"
SQL_ABSYears = "SELECT Min(StartDate) AS FirstStartDate, Max(EndDate) AS LastEndDate " _
             & "FROM " & sTableName
End Function
Public Function SQL_Application() As String
SQL_Application = "Select * from Application"
End Function
Public Sub CreateTempTable()
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim tdf As DAO.TableDef
Dim sSQL As String
Const sTempTableName As String = "tempForeCast"
Dim sYears() As String
Dim sYearFlds As String
Dim iFYear As Integer
Dim iLYear As Integer
Dim iCnt As Integer
Dim sAmounts() As String
Dim sAmount As String
Set dbs = CurrentDb
'Delete temptable if exists
For Each tdf In dbs.TableDefs
    If tdf.Name = sTempTableName Then dbs.TableDefs.Delete sTempTableName
Next tdf
'Fetch the absolute first date and last date
Set rs = dbs.OpenRecordset(SQL_ABSYears)
With rs
    If Not .EOF And Not .BOF Then
        .MoveFirst
        iFYear = Year(.Fields("FirstStartDate").Value) + 1
        iLYear = Year(.Fields("LastEndDate").Value)
    Else
        MsgBox "No data found", vbExclamation
        Exit Sub
    End If
    .Close
End With
'Create array holding all years between startdate and enddate
'- Amt in (US$)"
For iCnt = 0 To iLYear - iFYear '- 1
    ReDim Preserve sYears(iCnt)
    sYears(iCnt) = "[" & (iFYear + iCnt) & " - Amt in (US$)] Double"
Next iCnt
'Join years for create table sql
sYearFlds = Join(sYears, ", ")
sYearFlds = "ApplicationID Long, ProgramID Long, DisciplineID Long, EmployeeID Long, StartDate DateTime, EndDate DateTime, AmountApproved Double, " & sYearFlds
'create the temptable and index
sSQL = "Create Table " & sTempTableName & " (" & sYearFlds & ")"
dbs.Execute sSQL
sSQL = "CREATE UNIQUE INDEX [PrimaryKey] ON " & sTempTableName & " ([ApplicationID])  WITH PRIMARY DISALLOW NULL "
dbs.Execute sSQL
'Section to append data from Application to forecast
Set rs = dbs.OpenRecordset(SQL_Application)
With rs
    .MoveFirst
    Do Until .EOF
    
        'First determine the years to forecast
        sYearFlds = vbNullString
        ReDim sYears(0)
        ReDim sAmounts(0)
        iFYear = Year(.Fields("StartDate").Value) + 1
        iLYear = Year(.Fields("EndDate").Value)
        'create array for years to append
        For iCnt = 0 To iLYear - iFYear '- 1
            ReDim Preserve sYears(iCnt)
            ReDim Preserve sAmounts(iCnt)
            sYears(iCnt) = "[" & (iFYear + iCnt) & " - Amt in (US$)]"
            sAmounts(iCnt) = "'" & .Fields("AmountApproved").Value / (iLYear - (iFYear - 1)) & "'"
        Next iCnt
        sYearFlds = Join(sYears, ", ")
        sAmount = Join(sAmounts, ", ")
        'construct the insert statment
        sSQL = "Insert Into " & sTempTableName & "(ApplicationID, ProgramID, DisciplineID, EmployeeID, StartDate, EndDate, AmountApproved, " & sYearFlds & ")" _
             & "Values (" & .Fields("ApplicationID").Value & ", " & .Fields("ProgramID").Value & ", " & .Fields("DisciplineID").Value & ", " & .Fields("EmployeeID").Value & ", #" & .Fields("StartDate").Value & "#, #" & .Fields("EndDate").Value & "#, '" & .Fields("AmountApproved").Value & "', " & sAmount & ")"
        'insert values into temptable
        dbs.Execute sSQL
    .MoveNext
    Loop
End With
End Sub
 
Upvote 0
Thank you so very much.

I tested it with only one record and it worked perfectly. I will try it with additional records shortly.

I have been working on this since Mar 24th, 2011, so I sincerely thank you for taking the time to assist. I know that I would have been unable to figure this out on my own.

Thank you!
 
Upvote 0
You must log in or register to reply here.

Similar threads

W
  • Question Question
Microsoft Access 2016 query date/time extended
Replies
1
Views
991
jackd
J
T
  • Solved
Access table set start of day and end of day to my schedule
Replies
2
Views
639
Tcurtis
T
B
  • Question Question
VBA Query with Query Criteria
Replies
3
Views
1K
Micron
M
L
  • Solved
Help Please
2 3
Replies
21
Views
513
Asbestos_Jen
Asbestos_Jen
G
  • Question Question
V/Hlookup or Index/Match assistance Required?
Replies
7
Views
100
etaf
etaf

Forum statistics

Threads
1,224,521
Messages
6,179,291
Members
452,902
Latest member
Knuddeluff

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top