Force user to enter data on adjacent column if option from list is selected

[lucid33]

Hi all,

I have a dropdown list on column AY with 'In-Scope' & 'Removed' as the options.

If a user selects 'Removed' I wanted to force them to enter free text in column AZ to explain why they selected 'Removed'.

Is there any way to do this? The file is also shared.

Many thanks

 

[lucid33]

I have this code so far I got from another tread. What I'd like it to do is after 'Removed' is selected on say cell AY3 , it checks if cell AZ3 is blank, if it is blank, it resets AY3 back to 'In-Scope', if AZ3 has text, it updates it to 'Removed'

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Column = 51 Then    'column 1 is column A
        If Target = "Removed" Then
            Response = MsgBox("Please Enter reason on column AZ", vbYesNo)
            Application.EnableEvents = False
            If Response = vbNo Then
                Target = "No"
            ElseIf Response = vbYes Then
                Target = "Removed"
            End If
        End If
    End If
    Application.EnableEvents = True
End Sub

 

[JGordon11]

try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Or Target.Column <> 51 Then Exit Sub 'Check for Entry in a single cell in Column AY
    If Target = "Removed" Then
        Response = InputBox("Enter reason for removal from scope below:", "Reason for removal")
        Application.EnableEvents = False
        If Len(Response) = 0 Then
            Target = "In-Scope"
        Else
           Cells(Target.Row, Target.Column + 1) = Now() & " " & Application.UserName & ": " & Response
        End If
    End If
    Application.EnableEvents = True
End Sub

 

[lucid33]

try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Or Target.Column <> 51 Then Exit Sub 'Check for Entry in a single cell in Column AY
    If Target = "Removed" Then
        Response = InputBox("Enter reason for removal from scope below:", "Reason for removal")
        Application.EnableEvents = False
        If Len(Response) = 0 Then
            Target = "In-Scope"
        Else
           Cells(Target.Row, Target.Column + 1) = Now() & " " & Application.UserName & ": " & Response
        End If
    End If
    Application.EnableEvents = True
End Sub

Worked great, many thanks

 

[JGordon11]

You're welcome. Note that if a column or columns are inserted or deleted before column AY then this will not work as intended (because 51 is hardwired into the code and will not change dynamically). If there is a possibility that columns will be added or removed, then you should name the top header cell in AY something like ScopeStatus

by either a) clicking on the Column header (or top data cell if no headers) and in the name box in the upper left where it displays AYx (where x is the row of the cell you selected) type ScopeStatus and press enter (you should now have ScopeStatus in the name box instead of AYx), or

b) Formulas, Define Name, Name: ScopeStatus, Scope: Workbook, Refers To: =Sheet1!$AY$x:$AY$x OK (but change x to the row number and Sheet1 to your sheet name)

and then change the first line of the code to:

If Target.Count > 1 Or Target.Column <> [ScopeStatus].column Then Exit Sub 'Check for Entry in a single cell in Column ScopeStatus

 

[lucid33]

You're welcome. Note that if a column or columns are inserted or deleted before column AY then this will not work as intended (because 51 is hardwired into the code and will not change dynamically). If there is a possibility that columns will be added or removed, then you should name the top header cell in AY something like ScopeStatus

by either a) clicking on the Column header (or top data cell if no headers) and in the name box in the upper left where it displays AYx (where x is the row of the cell you selected) type ScopeStatus and press enter (you should now have ScopeStatus in the name box instead of AYx), or

b) Formulas, Define Name, Name: ScopeStatus, Scope: Workbook, Refers To: =Sheet1!$AY$x:$AY$x OK (but change x to the row number and Sheet1 to your sheet name)

and then change the first line of the code to:

If Target.Count > 1 Or Target.Column <> [ScopeStatus].column Then Exit Sub 'Check for Entry in a single cell in Column ScopeStatus

Hi, just wondering is it possible to force the user to choose from a dropdown list if 'Removed' is selected on column AY3.

If the user selects 'Removed' on AY3, a prompt would pop up with a validation list for column AZ3 e.g Yes, No.
Instead of the user just writing free text like the code above.

Thanks again.

 

[JGordon11]

That can be done using a userform containing a listbox and Ok/Cancel buttons. It gets a little trickier setting those up.

Using the same InputBox technique you can get a similar validation. Change the Reasons = Array ... line to your list in the code below. Note that you should keep each item less than about 20 characters long or the line will wrap and the formatting of the inputbox will look terrible. If you need longer items or your list is very long then you would need to go with the userform approach.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Count > 1 Or Target.Column <> 51 Then Exit Sub 'Check for Entry in a single cell in Column AY
    
    If Target = "Removed" Then
        Dim Response As String, LetterCheck As String, msg As String
        
        Reasons = Array("", "Reason 1", "Reason 2", "Reason 3", "Reason 4", "Reason 5", "Reason 6")
        
        msg = "Enter letter code for reason for removal from scope below:" & vbCrLf & vbCrLf
        For i = 1 To UBound(Reasons)
            msg = msg & Chr(64 + i) & vbTab & Reasons(i) & vbCrLf
        Next
        
        Response = UCase(InputBox(msg, "Reason for removal"))
        
        LetterCheck = "[A-" & Chr(64 + UBound(Reasons)) & "]"
        
        Application.EnableEvents = False
        If Not Response Like LetterCheck Then
            Target = "In-Scope"
            MsgBox "Invalid reason code"
        Else
            Cells(Target.Row, Target.Column + 1).Value = Reasons(Asc(Response) - 64)
        End If
        Application.EnableEvents = True
        
    End If
End Sub