• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 343
  • Last Modified:

Function not returning correct year in date

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
ssmith94015
Asked:
ssmith94015
  • 10
  • 7
  • 2
  • +1
2 Solutions
 
ssmith94015Author Commented:
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
 
DatabaseMX (Joe Anderson - Microsoft MVP, Access and Data Platform)Commented:
You have

Dim strYearEnd As String

but you forgot to do this:

strYearEnd=strPeriodRangeType

mx
0
 
DatabaseMX (Joe Anderson - Microsoft MVP, Access and Data Platform)Commented:
So, none of the Case statements were triggering !

mx
0
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
ssmith94015Author Commented:
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
 
aikimarkCommented:
Please post the current version of the routine that is partially working for you.
0
 
Kenneth BrownResearch AssociateCommented:
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
 
ssmith94015Author Commented:
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
 
ssmith94015Author Commented:
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
 
DatabaseMX (Joe Anderson - Microsoft MVP, Access and Data Platform)Commented:
All the cases seem to be working now ... where are you getting 1899 ?

mx
0
 
DatabaseMX (Joe Anderson - Microsoft MVP, Access and Data Platform)Commented:
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
 
Kenneth BrownResearch AssociateCommented:
Thanks, glad to be of some help...
0
 
ssmith94015Author Commented:
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
 
ssmith94015Author Commented:
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
 
DatabaseMX (Joe Anderson - Microsoft MVP, Access and Data Platform)Commented:
I already contacted the mods ... thx.

mx
0
 
ssmith94015Author Commented:
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
 
DatabaseMX (Joe Anderson - Microsoft MVP, Access and Data Platform)Commented:
thx.  Really wasn't about the points, but what someone in the future will see as the actual answer/solution.

mx
0
 
ssmith94015Author Commented:
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
 
DatabaseMX (Joe Anderson - Microsoft MVP, Access and Data Platform)Commented:
Well, I certainly appreciate that feedback and it's always a pleasure to help.

Thank you for using Experts Exchange.

mx
0
 
ssmith94015Author Commented:
alias99, thank you.  
0
 
ssmith94015Author Commented:
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

[Webinar] Improve your customer journey

A positive customer journey is important in attracting and retaining business. To improve this experience, you can use Google Maps APIs to increase checkout conversions, boost user engagement, and optimize order fulfillment. Learn how in this webinar presented by Dito.

  • 10
  • 7
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now