Create static timestamp using VBA macro and data validation input

Pepper2

New Member
Joined
Aug 12, 2021
Messages
2
Office Version
  1. 365
Platform
  1. Windows
Hello
I have only just started using this forum and I could really use some help.
I am trying to create static timestamps in one column range "R" (R4:R56), dependent on/using a date entered in an adjacent column range "Q" (Q4:Q56) and data validation
input in R.
Using the data validation input, a number of days (a number from 0 - 5) are supposed to be added to the date in the adjacent cell in Q, and the calculated result displayed in
R. The final date in R has to be static and only displayed after input has been given in R, but the date displayed in Q should be dynamic (I already use excel TODAY() function for this).
Now for the interesting bit, I already have a vba macro that does this for the exact same setup in column ranges "P" (P4:P56) and "O" (O4:O56) e.g if I were to enter "1" into my data validation input in a P cell today (17/08/2021), it will display result 18/08/2021. But when I do the same thing in R, I get the result 01/01/00. See example table using xl2BB "Table Only" option (selecting "Mini Sheet" keeps freezing my excel workbook).

QUOTE TIME LAPSE QUOTE EXPIRESCONTRACT TIME LAPSEDUE BACK DATE
17/08/2101/01/00
17/08/2118/08/21


The cell formula for Q and O are the same, all relevant column ranges use the same short date format, everything is exactly the same but the results are different.
See example of VBA code below.

VBA Code:
Sub EnterQuoteDays()

       
      Dim EQ As Range
        For Each EQ In Range("P4:P56")
            If EQ.Value = CDate(1) Then
                EQ.Value = EQ.Offset(0, -1).Value + 1
            ElseIf EQ.Value = CDate(2) Then
                EQ.Value = EQ.Offset(0, -1).Value + 2
            ElseIf EQ.Value = CDate(3) Then
                EQ.Value = EQ.Offset(0, -1).Value + 3
            ElseIf EQ.Value = CDate(4) Then
                EQ.Value = EQ.Offset(0, -1).Value + 4
            ElseIf EQ.Value = CDate(5) Then
                EQ.Value = EQ.Offset(0, -1).Value + 5
            ElseIf EQ.Value = CDate(0) And EQ.Value <> "" Then
                EQ.Value = EQ.Offset(0, -1).Value
            End If
                
        Next

End Sub


Sub EnterContractDays()

     Dim EC As Range
        For Each EC In Range("R4:R56")
            If EC.Value = CDate(1) Then
                EC.Value = EC.Offset(0, -1).Value + 1
            ElseIf EC.Value = CDate(2) Then
                EC.Value = EC.Offset(0, -1).Value + 2
            ElseIf EC.Value = CDate(3) Then
                EC.Value = EC.Offset(0, -1).Value + 3
            ElseIf EC.Value = CDate(4) Then
                EC.Value = EC.Offset(0, -1).Value + 4
            ElseIf EC.Value = CDate(5) Then
                EC.Value = EC.Offset(0, -1).Value + 5
            ElseIf EC.Value = CDate(0) And EC.Value <> "" Then
                EC.Value = EC.Offset(0, -1).Value
            End If
        Next


End Sub

Please help.
 

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).

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
1,345
Office Version
  1. 2010
Platform
  1. Windows
No need to coerce the number of days into a date.
VBA Code:
Sub EnterContractDays()

     Dim EC As Range
        For Each EC In Range("R4:R56")
                EC.Value = EC.Offset(0, -1).Value + EC.Value
        Next EC
                
End Sub
 

Pepper2

New Member
Joined
Aug 12, 2021
Messages
2
Office Version
  1. 365
Platform
  1. Windows
No need to coerce the number of days into a date.
VBA Code:
Sub EnterContractDays()

     Dim EC As Range
        For Each EC In Range("R4:R56")
                EC.Value = EC.Offset(0, -1).Value + EC.Value
        Next EC
               
End Sub
Thank you for your quick response and for your help. For some reason, with the solution you gave the value in R changes every time I select a new cell. After a little tweaking, combining our code it ends up working perfectly, so thank you again. See formula below.

VBA Code:
Sub EnterContractDays()

     Dim EC As Range
        For Each EC In Range("R4:R56")
            If EC.Value = CDate(1) Then
                EC.Value = EC.Offset(0, -1).Value + EC.Value
            ElseIf EC.Value = CDate(2) Then
                EC.Value = EC.Offset(0, -1).Value + EC.Value
            ElseIf EC.Value = CDate(3) Then
                EC.Value = EC.Offset(0, -1).Value + EC.Value
            ElseIf EC.Value = CDate(4) Then
                EC.Value = EC.Offset(0, -1).Value + EC.Value
            ElseIf EC.Value = CDate(5) Then
                EC.Value = EC.Offset(0, -1).Value + EC.Value
            ElseIf EC.Value = CDate(0) And EC.Value <> "" Then
                EC.Value = EC.Offset(0, -1).Value
            End If
        Next
'
 
Learn Excel from Bill Jelen

Understanding data is crucial, and the easiest place to start is with Microsoft Excel.

Forum statistics

Threads
1,151,697
Messages
5,765,982
Members
425,320
Latest member
Galin

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
Top