Excel VBA place result in adjacent cell

Question

I've written the macro below which, I know, is probably very inefficient, but I am a novice and very inexperienced with VBA!

This macro is called anytime a value of "Yes" is entered into any cell in Column E. The way it is written though, the values entered/calculated will always appear in cells F2 and G2.

I'm trying to change this so that, for example, if E12="Yes" and a date is entered in the message box, that date and the calculated number of days will appear in F12 and G12, respectively. Each row of this spreadsheet will be a calculation for a different person.

Any help would be greatly appreciated. Thank you!

Sub GetStartDate()
Dim QtyEntry As Date
Dim Msg As String
Dim n As Integer
If ActiveCell.Value = "Yes" Then
Const MinDate As Date = #11/1/2017#
Const MaxDate As Date = #10/31/2018#
Msg = "Enter effective date in role and/or level in MM/DD/YYYY format for the 2017-2018 Performance Year"
Do
    QtyEntry = InputBox(Msg)
        If IsDate(QtyEntry) Then
        If QtyEntry >= MinDate And QtyEntry <= MaxDate Then Exit Do
        End If
        Msg = "Please enter valid date range within the Performance Year."
        Msg = Msg & vbNewLine
        Msg = Msg & "Please enter a date between " & MinDate & " and " & MaxDate
        Loop
n = DateDiff("d", QtyEntry, MaxDate)
Cells(2, 7) = n
ActiveSheet.Range("F2").Value = QtyEntry
Exit Sub
Else
    Cells(2, 7) = "365"
End If
End Sub

YowE3K YowE3K · Accepted Answer · 2017-11-30T20:07:06

This is probably as simple as changing the hard-coded 2 to be ActiveCell.Row:

Sub GetStartDate()
Dim QtyEntry As Date
Dim Msg As String
Dim n As Integer
If ActiveCell.Value = "Yes" Then
Const MinDate As Date = #11/1/2017#
Const MaxDate As Date = #10/31/2018#
Msg = "Enter effective date in role and/or level in MM/DD/YYYY format for the 2017-2018 Performance Year"
Do
    QtyEntry = InputBox(Msg)
        If IsDate(QtyEntry) Then
        If QtyEntry >= MinDate And QtyEntry <= MaxDate Then Exit Do
        End If
        Msg = "Please enter valid date range within the Performance Year."
        Msg = Msg & vbNewLine
        Msg = Msg & "Please enter a date between " & MinDate & " and " & MaxDate
        Loop
n = DateDiff("d", QtyEntry, MaxDate)
Cells(ActiveCell.Row, 7) = n
ActiveSheet.Range("F" & ActiveCell.Row).Value = QtyEntry
Exit Sub
Else
    Cells(ActiveCell.Row, 7) = "365"
End If
End Sub

Excel VBA place result in adjacent cell

1 Answers