Solved: DateAdd Function

[LLL]

Hello all. I am having trouble with my code returning improper dates:

Example: The date in the form may be 9/3/2009. When it performs the add function it returns something like this 1/11/1901, instead returning the date 9/3/2010, as I would like for it to. Here is a snippet of the code that is the problem I am guessing. At the end of this code you will see the date add function. Any guesses as to if the way this is entered may be causing this. Thanks for any help!

[vba]Case 26
Dim lngCurrentRow As Long
lngCurrentRow = Selection.Row
Dim intMessage As Integer
Dim intMessage2 As Integer
Dim strInterval As String
Dim PaidThruDate As Integer


Dim intNumber As Integer
Dim WBErow2 As Long
Dim WBEcol1 As Long

strInterval = "yyyy"
intNumber = 1
WBEcol1 = 12


If IsDate(Cells(lngCurrentRow, 26).Value) = True Then
If MatchTheCriteria2(lngCurrentRow) = 0 Then
MsgBox "Not yet in the WBE Profile2 file " & vbCrLf & _
"Record not found in WBE Profile2 matching this record"
Exit Sub
Else
WBErow2 = MatchTheCriteria2(lngCurrentRow)
intMessage2 = MsgBox("Are you sure about this data?" & vbCrLf & _
Range("A" & lngCurrentRow).Value & vbCrLf & _
Range("B" & lngCurrentRow).Value & vbCrLf & _
Range("C" & lngCurrentRow).Value & vbCrLf & _
Range("D" & lngCurrentRow).Value & vbCrLf & _
Range("E" & lngCurrentRow).Value & vbCrLf & _
Range("F" & lngCurrentRow).Value & vbCrLf & _
Range("G" & lngCurrentRow).Value & vbCrLf & _
Range("H" & lngCurrentRow).Value & vbCrLf & _
Range("I" & lngCurrentRow).Value & vbCrLf & _
Range("J" & lngCurrentRow).Value & vbCrLf & _
Range("K" & lngCurrentRow).Value, vbOKCancel + vbQuestion + vbApplicationModal, "Query")

Select Case intMessage2
Case vbOK
Workbooks("WBE Profile2.xls").Worksheets("WBE_Profile").Cells(WBErow2, WBEcol1).Value = DateAdd(strInterval, intNumber, 12)
Cells(lngCurrentRow, 26).EntireRow.Delete
MsgBox "Successfully entered the data to WBE Profile2.xls"
Case vbCancel
End Select[/vba]

[Paul_Hossler]

DateAdd(interval, number, date)
The DateAdd function syntax has these named arguments:
PartDescriptionintervalRequired. String expression that is the interval of time you want to add.numberRequired. Numeric expression that is the number of intervals you want to add. It can be positive (to get dates in the future) or negative (to get dates in the past).dateRequired. Variant (Date) or literal representing date to which the interval is added.

[vba]

strInterval = "yyyy"
intNumber = 1
and

=DateAdd(strInterval, intNumber, 12)

[/vba]

I don't think you're using the DateAdd function the way you want.

Dates are counted in days from Jan 1, 1900, so it seems like you're adding 1 year to 1/12/1900 = 1/11/1901

Paul

[p45cal]

On another point, this:[vba]intMessage2 = MsgBox("Are you sure about this data?" & vbCrLf & _
Range("A" & lngCurrentRow).Value & vbCrLf & _
Range("B" & lngCurrentRow).Value & vbCrLf & _
Range("C" & lngCurrentRow).Value & vbCrLf & _
Range("D" & lngCurrentRow).Value & vbCrLf & _
Range("E" & lngCurrentRow).Value & vbCrLf & _
Range("F" & lngCurrentRow).Value & vbCrLf & _
Range("G" & lngCurrentRow).Value & vbCrLf & _
Range("H" & lngCurrentRow).Value & vbCrLf & _
Range("I" & lngCurrentRow).Value & vbCrLf & _
Range("J" & lngCurrentRow).Value & vbCrLf & _
Range("K" & lngCurrentRow).Value, vbOKCancel + vbQuestion + vbApplicationModal, "Query")
[/vba]could be considerably shortened either to this:[vba]msg = "Are you sure about this data?" & vbLf
For i = 1 To 11: msg = msg & vbLf & Cells(lngCurrentRow, i): Next i
intMessage2 = MsgBox(msg, vbOKCancel + vbQuestion + vbApplicationModal, "Query")
[/vba]or - a slight variant:[vba]msg = "Are you sure about this data?" & vbLf
For Each cll In Range("A" & lngCurrentRow & ":K" & lngCurrentRow).Cells: msg = msg & vbLf & cll.Value: Next cll
intMessage2 = MsgBox(msg, vbOKCancel + vbQuestion + vbApplicationModal, "Query")
[/vba]

[LLL]

Thanks Paul. I am trying to get it to add 1 year to the "PaidThruDate", see below in bold italics, along with date add at the end. Can you help me out with that? Any additional help would be great.

[vba]Dim lngCurrentRow As Long
lngCurrentRow = Selection.Row
Dim intMessage As Integer
Dim intMessage2 As Integer
Dim strInterval As String
Dim PaidThruDate As Integer


Dim intNumber As Integer
Dim WBErow2 As Long
Dim WBEcol1 As Long

strInterval = "yyyy"
intNumber = 1
WBEcol1 = 12


If IsDate(Cells(lngCurrentRow, 26).Value) = True Then
If MatchTheCriteria2(lngCurrentRow) = 0 Then
MsgBox "Not yet in the WBE Profile2 file " & vbCrLf & _
"Record not found in WBE Profile2 matching this record"
Exit Sub
Else
WBErow2 = MatchTheCriteria2(lngCurrentRow)
intMessage2 = MsgBox("Are you sure about this data?" & vbCrLf & _
Range("A" & lngCurrentRow).Value & vbCrLf & _
Range("B" & lngCurrentRow).Value & vbCrLf & _
Range("C" & lngCurrentRow).Value & vbCrLf & _
Range("D" & lngCurrentRow).Value & vbCrLf & _
Range("E" & lngCurrentRow).Value & vbCrLf & _
Range("F" & lngCurrentRow).Value & vbCrLf & _
Range("G" & lngCurrentRow).Value & vbCrLf & _
Range("H" & lngCurrentRow).Value & vbCrLf & _
Range("I" & lngCurrentRow).Value & vbCrLf & _
Range("J" & lngCurrentRow).Value & vbCrLf & _
Range("K" & lngCurrentRow).Value, vbOKCancel + vbQuestion + vbApplicationModal, "Query")

Select Case intMessage2
Case vbOK
Workbooks("WBE Profile2.xls").Worksheets("WBE_Profile").Cells(WBErow2, WBEcol1).Value = DateAdd(strInterval, intNumber, 12)
Cells(lngCurrentRow, 26).EntireRow.Delete
MsgBox "Successfully entered the data to WBE Profile2.xls"
Case vbCancel
End Select [/vba]

[LLL]

For anyone interested, I was able to fix my problem. The problem was the way I had the DateAdd statement set, it pulled from the computer date 1/11/1900 instead the the date in the specified cell.

Previous portion of statement that did not work:
[VBA]Workbooks("WBE Profile2.xls").Worksheets("WBE_Profile").Cells(WBErow2, WBEcol1).Value = DateAdd(strInterval, intNumber, 1[/VBA]

Statement that worked:
[VBA]Workbooks("WBE Profile2.xls").Worksheets("WBE_Profile").Cells(WBErow2, WBEcol1).Value = DateAdd("yyyy", 1, Format(CDate(Workbooks("WBE Profile2.xls").Worksheets("WBE_Profile").Cells(WBErow2, WBEcol1).Value), "m/d/yyyy"))[/VBA]