Solved

Function not returning correct year in date

Posted on 2010-11-15
21
325 Views
Last Modified: 2012-05-10
I have the function attached, but for thelife of me, I cannot figure out whyit keeps returning 1899 no matter what I do.  
Public Function OffsetsYearEnds(strPeriodRangeType As String) As Date

'Determines what the correct year end dates should be for annual reporting

Dim strYearEnd As String

Dim intMonth As Integer



intMonth = Month(Date)



Select Case strYearEnd

    Case "YRENDDEC"

        If intMonth > 1 Then

            OffsetsYearEnds = CDate("12/31/" & (Year(Date) - 1))

        Else

            OffsetsYearEnds = CDate("12/31/" & (Year(Date) - 2))

        End If

    Case "YRENDNOV"

        If intMonth > 11 Then

            OffsetsYearEnds = CDate("11/30" & Year(Date))

        Else

            OffsetsYearEnds = CDate("11/30/" & (Year(Date) - 1))

        End If

    Case "YRENDOCT"

        If intMonth > 10 Then

            OffsetsYearEnds = CDate("10/31" & Year(Date))

        Else

            OffsetsYearEnds = CDate("10/31/" & (Year(Date) - 1))

        End If

    Case "YRENDSEP"

        If intMonth > 9 Then

            OffsetsYearEnds = CDate("9/30" & Year(Date))

        Else

            OffsetsYearEnds = CDate("7/30/" & (Year(Date) - 1))

        End If

    Case "YRENDAUG"

        If intMonth > 8 Then

            OffsetsYearEnds = CDate("8/31" & Year(Date))

        Else

            OffsetsYearEnds = CDate("8/31/" & (Year(Date) - 1))

        End If

    Case "YRENDJUL"

        If intMonth > 7 Then

            OffsetsYearEnds = CDate("7/31" & Year(Date))

        Else

            OffsetsYearEnds = CDate("7/31/" & (Year(Date) - 1))

        End If

    Case "YRENDJUN"

        If intMonth > 6 Then

            OffsetsYearEnds = CDate("6/30" & Year(Date))

        Else

            OffsetsYearEnds = CDate("6/30/" & (Year(Date) - 1))

        End If

    Case "YRENDMAY"

        If intMonth > 5 Then

            OffsetsYearEnds = "5/31" & Year(Date)

        Else

            OffsetsYearEnds = "5/31/" & (Year(Date) - 1)

        End If

    Case "YRENDAPR"

        If intMonth > 4 Then

            OffsetsYearEnds = CDate("4/30" & Year(Date))

        Else

            OffsetsYearEnds = CDate("4/30/" & (Year(Date) - 1))

        End If

    Case "YRENDMAR"

        If intMonth > 3 Then

            OffsetsYearEnds = CDate("3/31" & Year(Date))

        Else

            OffsetsYearEnds = CDate("3/31/" & (Year(Date) - 1))

        End If

    Case "YRENDFEB"

        If intMonth > 2 Then

            OffsetsYearEnds = CDate("3/1" & Year(Date)) - 1  'Avoids leap year problem simply to take March 1st less one day

        Else

            OffsetsYearEnds = CDate("3/1" & Year(Date) - 1) - 1

        End If

    Case "YRENDJAN"

        If intMonth > 1 Then

            OffsetsYearEnds = CDate("1/31" & Year(Date))

            Debug.Print OffsetsYearEnds

        Else

            OffsetsYearEnds = CDate("1/31/" & (Year(Date) - 1))

        End If

    Case "YRENDFEB"

        If intMonth > 2 Then

            OffsetsYearEnds = CDate("3/1" & Year(Date)) - 1  'Avoids leap year problem simply to take March 1st less one day

        Else

            OffsetsYearEnds = CDate("3/1" & Year(Date) - 1) - 1

        End If

End Select



Debug.Print FormatDateTime(OffsetsYearEnds, vbShortDate)

End Function

Open in new window

0
Comment
Question by:ssmith94015
  • 10
  • 7
  • 2
  • +1
21 Comments
 

Author Comment

by:ssmith94015
ID: 34140034
Ok, I found a typo in that not all the data had the closing "/". But even when I fixed that, it still returns 12/30/1899 for all dates
0
 
LVL 75

Accepted Solution

by:
DatabaseMX (Joe Anderson - Access MVP) earned 450 total points
ID: 34140073
You have

Dim strYearEnd As String

but you forgot to do this:

strYearEnd=strPeriodRangeType

mx
0
 
LVL 75
ID: 34140077
So, none of the Case statements were triggering !

mx
0
 

Author Comment

by:ssmith94015
ID: 34140080
Ok, found second error in that the Select Case statement needed to use the passed-in variable, strPeriodRangeType.  Now I am getting some correct dates and some still in the 12/30/1899 date.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 34140141
Please post the current version of the routine that is partially working for you.
0
 
LVL 5

Assisted Solution

by:KenIBrown2
KenIBrown2 earned 50 total points
ID: 34140147
Post your updated code.
Theres probably another typo.
More haste less speed. Read through what youve done as if youve never seen it before, & check it would do what you wanted it to do....
0
 

Author Comment

by:ssmith94015
ID: 34140167
Attached is the code.  Yes, I am going too fast.
Public Function OffsetsYearEnds(strPeriodRangeType As String) As Date

'Determines what the correct year end dates should be for annual reporting

Dim strYearEnd As String

Dim intMonth As Integer



intMonth = Month(Date)



Select Case strPeriodRangeType

    Case "YRENDDEC"

        If intMonth > 1 Then

            OffsetsYearEnds = CDate("12/31/" & (Year(Date) - 1))

        Else

            OffsetsYearEnds = CDate("12/31/" & (Year(Date) - 2))

        End If

    Case "YRENDNOV"

        If intMonth > 11 Then

            OffsetsYearEnds = CDate("11/30/" & Year(Date))

        Else

            OffsetsYearEnds = CDate("11/30/" & (Year(Date) - 1))

        End If

    Case "YRENDOCT"

        If intMonth > 10 Then

            OffsetsYearEnds = CDate("10/31/" & Year(Date))

        Else

            OffsetsYearEnds = CDate("10/31/" & (Year(Date) - 1))

        End If

    Case "YRENDSEP"

        If intMonth > 9 Then

            OffsetsYearEnds = CDate("9/30/" & Year(Date))

        Else

            OffsetsYearEnds = CDate("9/30/" & (Year(Date) - 1))

        End If

    Case "YRENDAUG"

        If intMonth > 8 Then

            OffsetsYearEnds = CDate("8/31/" & Year(Date))

        Else

            OffsetsYearEnds = CDate("8/31/" & (Year(Date) - 1))

        End If

    Case "YRENDJUL"

        If intMonth > 7 Then

            OffsetsYearEnds = CDate("7/31/" & Year(Date))

        Else

            OffsetsYearEnds = CDate("7/31/" & (Year(Date) - 1))

        End If

    Case "YRENDJUN"

        If intMonth > 6 Then

            OffsetsYearEnds = CDate("6/30/" & Year(Date))

        Else

            OffsetsYearEnds = CDate("6/30/" & (Year(Date) - 1))

        End If

    Case "YRENDMAY"

        If intMonth > 5 Then

            OffsetsYearEnds = "5/31/" & Year(Date)

        Else

            OffsetsYearEnds = "5/31/" & (Year(Date) - 1)

        End If

    Case "YRENDAPR"

        If intMonth > 4 Then

            OffsetsYearEnds = CDate("4/30/" & Year(Date))

        Else

            OffsetsYearEnds = CDate("4/30/" & (Year(Date) - 1))

        End If

    Case "YRENDMAR"

        If intMonth > 3 Then

            OffsetsYearEnds = CDate("3/31/" & Year(Date))

        Else

            OffsetsYearEnds = CDate("3/31/" & (Year(Date) - 1))

        End If

    Case "YRENDFEB"

        If intMonth > 2 Then

            OffsetsYearEnds = CDate("3/1/" & Year(Date)) - 1  'Avoids leap year problem simply to take March 1st less one day

        Else

            OffsetsYearEnds = CDate("3/1/" & Year(Date) - 1) - 1

        End If

    Case "YRENDJAN"

        If intMonth > 1 Then

            OffsetsYearEnds = CDate("1/31/" & Year(Date))

        Else

            OffsetsYearEnds = CDate("1/31/" & (Year(Date) - 1))

        End If

End Select



Debug.Print FormatDateTime(OffsetsYearEnds, vbShortDate)

End Function

Open in new window

0
 

Author Comment

by:ssmith94015
ID: 34140188
Ok, found the error is NOT in my code, it is in the underlying data source I was given!  Ok, yes, made a few but now that I have cleaned up the supposedly "clean" data - it seems to be working fine.
0
 
LVL 75
ID: 34140202
All the cases seem to be working now ... where are you getting 1899 ?

mx
0
 
LVL 75
ID: 34140223
Ahh ... I posted the correct solution @ http:#a34140073

With all due respect, the Accepted and Assisted answers are not really solutions or the cause of the problem ...

mx
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 5

Expert Comment

by:KenIBrown2
ID: 34148280
Thanks, glad to be of some help...
0
 

Author Comment

by:ssmith94015
ID: 34148877
DatabaseMX, you are correct but is there a timing issue to when answers are posted?  This is the first I have seen yours the only two were the ones I split the points to.  
0
 

Author Comment

by:ssmith94015
ID: 34148906
I am looking at the time sequence and DatabaseMX was in the first group.  I honestly do not know why DatabaseMX's responses were not updated to my viewing as he is correct and spotted the very first error I had.  I think I need to contact the moderator about this.
0
 
LVL 75
ID: 34149083
I already contacted the mods ... thx.

mx
0
 

Author Comment

by:ssmith94015
ID: 34149174
MOderator, have discussed issue with your Chat area and would like to re-distribute points as follows:

400 DatabaseMS
50 to KenBrown for suggesting I slow down (good point)
50 to aikiamark for also trying to help - I feel too guilty not to award points as this point but DatabaseMX is correct and probably diserves all - but I am a coward and don't want to penalize anyone for my system not refreshing properly!
0
 
LVL 75
ID: 34149223
thx.  Really wasn't about the points, but what someone in the future will see as the actual answer/solution.

mx
0
 

Author Comment

by:ssmith94015
ID: 34149307
Honestly, sometimes I simply do not know what to do.  But I am going to say, you (along with one or two others) consistently gve me answers the solve the issue quickly, clairify something or point me in the right direction.  Your tag is among one of the first I look for when I pose a question as well as when I am searching for an answer that may already exist.  Don't mean to sound saccarin but simply stating the way it is and I have appreciated, over these many years, all the help you have given.
0
 
LVL 75
ID: 34149362
Well, I certainly appreciate that feedback and it's always a pleasure to help.

Thank you for using Experts Exchange.

mx
0
 

Author Comment

by:ssmith94015
ID: 34157167
alias99, thank you.  
0
 

Author Closing Comment

by:ssmith94015
ID: 34157231
Ok, have re-assigned points.  Based on the moderator's advice, just going to assign to the two suggestions that helped (I really DO need to slow down and be reminded of that).    I still appreciate the attention by all.
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

MS Access 2003 or later To MySQL Migration Project Hello All, this is my second article in the category of MS-OFFICE Automation. In internet I am not able to find any comprehensive resource on the Migration of MS Access back-end to MySQL so I fin…
As with any other System Center product, the installation for the Authoring Tool can be quite a pain sometimes. This article serves to help you avoid making these mistakes and hopefully save you a ton of time on troubleshooting :)  Step 1: Make sur…
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.
This is Part 3 in a 3-part series on Experts Exchange to discuss error handling in VBA code written for Excel. Part 1 of this series discussed basic error handling code using VBA. http://www.experts-exchange.com/videos/1478/Excel-Error-Handlin…

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now