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
I am getting an error when the I have more than one application record.

Code: 
dbs.Execute sSQL
.MoveNext
    Loop
End With
End Sub

The error occurs at the dbs.Execute sSQL line. It works perfectly with one record.
 
Upvote 0

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Run-time error '3134':

Syntax error in INSERT INTO statement.

I have removed 2 fields from the query and here is the revised code:

Code: 
sSQL = "Insert Into " & sTempTableName & "(ApplicationID, EmployeeID, StartDate, EndDate, AmountApproved, " & sYearFlds & ")" _
             & "Values (" & .Fields("ApplicationID").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
I can't explain why it doesn't work, if I addapt your changes into the code here, it still runs without any problems. And I'm testing with a few records. :confused:

Can you paste the complete bit of code as you use it?

Edit:

Are there by any change comma's in the data you try to append? (exept for the amounts)
 
Last edited:
Upvote 0
No problem.

Code: 
Option Compare Database
Option Explicit

Public Function SQL_ABSYears() As String

Const sTableName As String = "tblApplication"
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 tblApplication"
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 = "ttblForeCast"
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, 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, EmployeeID, StartDate, EndDate, AmountApproved, " & sYearFlds & ")" _
             & "Values (" & .Fields("ApplicationID").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
Works as designed.
So it has to be something with the data.

Could you please post an example of the actual data you try to append?
 
Upvote 0
My apologies. The "error" is on my end.

Employees will sometimes take short courses that are less than 1 year. In those instances, the entire Amount Approved is disbursed.

I assume that is the error as when I changed the End Dates so that it is at least a year, it works.

Any idea how I would handle the applications where the course of study is less than a year?
 
Upvote 0
No problem. This is an easy fix, assuming that if the start and end date are in the same year, the forecast will also be in that year.

The changes are marked

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 = "ttblForeCast"
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)[B][COLOR=darkred] ' + 1[/COLOR][/B]
        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, 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)
      [B][COLOR=darkred]  If iFYear > iLYear Then iFYear = iFYear - 1[/COLOR][/B]
            
        '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, EmployeeID, StartDate, EndDate, AmountApproved, " & sYearFlds & ")" _
             & "Values (" & .Fields("ApplicationID").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
on the other hand, you say the amount is disbursed when a course ends within the same year, so you don't want it in your forecast.

Maybe this option is the best one. Code below skips the courses ending in the same year.

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 = "ttblForeCast"
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, 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)
        If iFYear > iLYear Then
                GoTo skipAppl
        End If
        '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, EmployeeID, StartDate, EndDate, AmountApproved, " & sYearFlds & ")" _
             & "Values (" & .Fields("ApplicationID").Value & ", " & .Fields("EmployeeID").Value & ", #" & .Fields("StartDate").Value & "#, #" & .Fields("EndDate").Value & "#, '" & .Fields("AmountApproved").Value & "', " & sAmount & ")"
             
        'insert values into temptable
        dbs.Execute sSQL
skipAppl:
    .MoveNext
    Loop
End With
End Sub
 
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