• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Data Validation with Constraints

J

JPhotonics

Member
I have a Data Validation drop-down list that I'd like to not allow to be used unless another cell displays certain text. Is this possible?

Specifically, I want this Data Validation (titled "Approval_List") to look at Cell D9 to see if it displays "Completed". If it does not display "Completed", I do not want the drop-down selections to be available.
 
Nebu said:
Hi:

Find the sample attached.

Note: You need VBA for this

Thanks
Click to expand...

I took that VBA and tailored it to my worksheet, but it does not appear to be working. I have some other VBA code that is supposed to function to create a timestamp when a certain selection (Approved or Approved w/ Comments) is made. I am wondering if it is due to a problem with the order I am using or my VBA layout because it seemed to be working previously.

I have attached my actual worksheet to this post to show you. I have VBA doing (or attempting) the following:
  1. AutoFitting my "Comments" row to expand/retract as needed.
  2. Displaying a certain text and filled cell for a handful of cells which should retain their original text if deleted/cleared.
  3. Create a timestamp of when "Approved" or "Approved w/ Comments" is selected for the Phase Status, only removing the timestamp if the answer is deleted or changed to "Rejected" or "Not Applicable".
  4. Do not allow the Phase Status Drop-Down Validation unless Overall Task Status (D9) displays "Completed".
#1 & #2 seem to be functioning properly. #3 & #4 are not currently functioning properly and I am having trouble figuring out why. My current VBA Code is at the bottom of this post as well as in the file attached.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

Range("B10:J10").Rows.AutoFit
Range("B24:J24").Rows.AutoFit
Range("B34:J34").Rows.AutoFit

If Not Intersect(Target, Range("D3")) Is Nothing Then
    If Target.Resize(1, 1).Value = "" Then
        Target.Resize(1, 1).Value = "< Project Name >"
        Target.Interior.ColorIndex = 40
    End If
End If

If Not Intersect(Target, Range("D4")) Is Nothing Then
    If Target.Resize(1, 1).Value = "" Then
        Target.Resize(1, 1).Value = "< Project Manager >"
        Target.Interior.ColorIndex = 40
    End If
End If

If Not Intersect(Target, Range("D5")) Is Nothing Then
        If Target.Resize(1, 1).Value = "" Then
        Target.Resize(1, 1).Value = "< Primary Contact Email >"
        Target.Interior.ColorIndex = 40
        Range("D5").Hyperlinks.Delete
        Range("D5").Font.Underline = False
        Range("D5").Font.Color = 0
    End If
End If

If Not Intersect(Target, Range("D6")) Is Nothing Then
    If Target.Resize(1, 1).Value = "" Then
        Target.Resize(1, 1).Value = "< Primary Contact Phone >"
        Target.Interior.ColorIndex = 40
    End If
End If

If Not Intersect(Target, Range("I8")) Is Nothing Then
    If Target.Resize(1, 1).Value = "" Then
        Target.Resize(1, 1).Value = "Pending Review"
        Target.Interior.ColorIndex = 25
    End If
End If
If Not Intersect(Target, Range("I22")) Is Nothing Then
    If Target.Resize(1, 1).Value = "" Then
        Target.Resize(1, 1).Value = "Pending Review"
        Target.Interior.ColorIndex = 25
    End If
End If
If Not Intersect(Target, Range("I32")) Is Nothing Then
    If Target.Resize(1, 1).Value = "" Then
        Target.Resize(1, 1).Value = "Pending Review"
        Target.Interior.ColorIndex = 25
    End If
End If

Application.EnableEvents = False
   If Target.Value = vbNullString Then
        Range("D9").Validation.Modify Type:=xlValidateInputOnly
   Else
        Range("D9").Validation.Modify Type:=xlValidateList, Formula1:="Approval_List"
   End If
Application.EnableEvents = True



If Target.Address <> "$I$9" And Target.Address <> "$I$23" And Target.Address <> "$I$33" Then
If Range("I8").Text = "APPROVED" Or Range("I8").Text = "APPROVED W/ COMMENTS" Then
If Range("$I$9").Text = "" Then
Range("E11").FormulaR1C1 = "=NOW()"
Range("I9").Copy
Range("I9").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
End If
Else
Range("I9").FormulaR1C1 = ""
End If

If Range("I22").Text = "APPROVED" Or Range("I22").Text = "APPROVED W/ COMMENTS" Then
If Range("$I$23").Text = "" Then
Range("I23").FormulaR1C1 = "=NOW()"
Range("I23").Copy
Range("I23").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
End If
Else
Range("I23").FormulaR1C1 = ""
End If

If Range("I32").Text = "APPROVED" Or Range("I32").Text = "APPROVED W/ COMMENTS" Then
If Range("$I$33").Text = "" Then
Range("I33").FormulaR1C1 = "=NOW()"
Range("I33").Copy
Range("I33").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
End If
Else
Range("I33").FormulaR1C1 = ""
End If

End If

End Sub
 

Attachments

  • Stage Gate Checklist - with Tasks.xlsm
    29.7 KB · Views: 2
Hi:

Do the attached do what you want?

Thanks
 

Attachments

  • Stage Gate Checklist - with Tasks.xlsm
    29 KB · Views: 9
Nebu said:
Hi:

Do the attached do what you want?

Thanks
Click to expand...

Yes sir! Thank you very much for your help. Why did you add the VBA "Application.ScreenUpdating = False" at the top though?

Also, my timestamping is still not working... I am not sure why.

The VBA Nebu attached is shown below. I simply duplicated this code to add my other constraints I wanted to use. It works great and does not allow the user to select an option from the drop-down menu unless my other cell displays "Completed".
Code: 
myList$ = Range("Approval_List").Address
Application.EnableEvents = False
With Range("I8")
   If Range("D9") = "Completed" Then
    .Validation.Modify Type:=xlValidateList, Formula1:="=" & myList
   Else
    .Validation.Modify Type:=xlValidateInputOnly
   End If
End With
Application.EnableEvents = True
 
I have figured the timestamping issue out...

The problem was that the VBA had "APPROVED" and "APPROVED W/ COMMENTS" instead of the correct "Approved" and "Approved w/ Comments".

Remember CAPITALIZATION MATTERS.:DD
 
@JPhotonics

Also note that there's no code line that specifies when to fire bottom section of your code (after Nebu's code). So it will run every time any cell changes on the sheet.

Personally I'd recommend splitting out format & value change operation out to Subs in Regular Module, and call it on worksheet change.

Something like below.

In Worksheet module:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False

Range("B10:J10").Rows.AutoFit
Range("B24:J24").Rows.AutoFit
Range("B34:J34").Rows.AutoFit

If Not Intersect(Target, Range("D3:D6")) Is Nothing Then
    If Target.Resize(1, 1).Value = "" Then dColChange Target
End If

If Not Intersect(Target, Union(Range("I8"), Range("I22"), Range("I32"))) Is Nothing Then
    iColChange Target
End If

myList$ = Range("Approval_List").Address
Application.EnableEvents = False
With Range("I8")
  If Range("D9") = "Completed" Then
    .Validation.Modify Type:=xlValidateList, Formula1:="=" & myList
  Else
    .Validation.Modify Type:=xlValidateInputOnly
  End If
End With

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

In Regular Module:
Code: 
'Sub for D3:D6 range change
Sub dColChange(tRange As Range)

tRange.Interior.ColorIndex = 40

Select Case tRange.Resize(1, 1)
    Case Range("D3")
        Range("D3").Value = "< Project Name >"
    Case Range("D4")
        Range("D4").Value = "< Project Manager >"
    Case Range("D5")
        With Range("D5")
            .Value = "< Primary Contact Email >"
            .Hyperlinks.Delete
            .Font.Underline = False
            .Font.Color = 0
        End With
    Case Range("D6")
        Range("D6").Value = "< Primary Contact Phone >"
End Select

End Sub
'Sub for Cells I8, I22 & I32 change
Sub iColChange(tRange As Range)
With tRange.Resize(1, 1)
    If .Value = "" Then
        .Value = "Pending Review"
        .Offset(1).Value = ""
        tRange.Interior.ColorIndex = 25
    ElseIf InStr(1, .Value, "APPROVED", vbTextCompare) > 0 Then
        If .Offset(1).Value = "" Then
            .Offset(1).Value = Now
        End If
    Else
        .Offset(1).Value = ""
    End If
End With
End Sub

Note: InStr function has argument for compare method "vbTextCompare" is used here to ignore case.

See attached sample.

Edit: Woops. Uploaded without saving final. See attached now.
 

Attachments

  • Stage Gate Checklist - with Tasks (1).xlsm
    29.4 KB · Views: 2
Last edited:
Chihiro said:
@JPhotonics

Also note that there's no code line that specifies when to fire bottom section of your code (after Nebu's code). So it will run every time any cell changes on the sheet.

Personally I'd recommend splitting out format & value change operation out to Subs in Regular Module, and call it on worksheet change.

Something like below.

In Worksheet module:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False

Range("B10:J10").Rows.AutoFit
Range("B24:J24").Rows.AutoFit
Range("B34:J34").Rows.AutoFit

If Not Intersect(Target, Range("D3:D6")) Is Nothing Then
    If Target.Resize(1, 1).Value = "" Then dColChange Target
End If

If Not Intersect(Target, Union(Range("I8"), Range("I22"), Range("I32"))) Is Nothing Then
    iColChange Target
End If

myList$ = Range("Approval_List").Address
Application.EnableEvents = False
With Range("I8")
  If Range("D9") = "Completed" Then
    .Validation.Modify Type:=xlValidateList, Formula1:="=" & myList
  Else
    .Validation.Modify Type:=xlValidateInputOnly
  End If
End With

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

In Regular Module:
Code: 
'Sub for D3:D6 range change
Sub dColChange(tRange As Range)

tRange.Interior.ColorIndex = 40

Select Case tRange.Resize(1, 1)
    Case Range("D3")
        Range("D3").Value = "< Project Name >"
    Case Range("D4")
        Range("D4").Value = "< Project Manager >"
    Case Range("D5")
        With Range("D5")
            .Value = "< Primary Contact Email >"
            .Hyperlinks.Delete
            .Font.Underline = False
            .Font.Color = 0
        End With
    Case Range("D6")
        Range("D6").Value = "< Primary Contact Phone >"
End Select

End Sub
'Sub for Cells I8, I22 & I32 change
Sub iColChange(tRange As Range)
With tRange.Resize(1, 1)
    If .Value = "" Then
        .Value = "Pending Review"
        .Offset(1).Value = ""
        tRange.Interior.ColorIndex = 25
    ElseIf InStr(1, .Value, "APPROVED", vbTextCompare) > 0 Then
        If .Offset(1).Value = "" Then
            .Offset(1).Value = Now
        End If
    Else
        .Offset(1).Value = ""
    End If
End With
End Sub

Note: InStr function has argument for compare method "vbTextCompare" is used here to ignore case.

See attached sample.

Edit: Woops. Uploaded without saving final. See attached now.
Click to expand...

Your attached example does not seem to function as desired. It allows me to select the Phase Status without any regard for the Task Status cell showing "Complete".

Will keeping things as-is cause problems? Your code looks quite a bit different than my current/original VBA.
 
Woops, my bad. Move Nebu's code to Worksheet Selection Change.

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
If Intersect(Target, Union(Range("I8"), Range("I22"), Range("I32"))) Is Nothing Then Exit Sub
myList$ = Range("Approval_List").Address
With Target.Resize(1, 1)
  If .Offset(1, -5).Resize(1, 1) = "Completed" Then
    .Validation.Modify Type:=xlValidateList, Formula1:="=" & myList
  Else
    .Validation.Modify Type:=xlValidateInputOnly
  End If
End With
Application.ScreenUpdating = True
End Sub

Just a suggestion for more modular code structure. So that you don't have too many hard coded areas to edit each time something changes on the sheet.
 
Chihiro said:
Woops, my bad. Move Nebu's code to Worksheet Selection Change.

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
If Intersect(Target, Union(Range("I8"), Range("I22"), Range("I32"))) Is Nothing Then Exit Sub
myList$ = Range("Approval_List").Address
With Target.Resize(1, 1)
  If .Offset(1, -5).Resize(1, 1) = "Completed" Then
    .Validation.Modify Type:=xlValidateList, Formula1:="=" & myList
  Else
    .Validation.Modify Type:=xlValidateInputOnly
  End If
End With
Application.ScreenUpdating = True
End Sub

Just a suggestion for more modular code structure. So that you don't have too many hard coded areas to edit each time something changes on the sheet.
Click to expand...

I am still not following how to split them up, I'll have to look into that more. Up to this point I have just been working with the main VBA screen that pops up.

In your example with the broken out module, I do not see the timestamping VBA code, but it appears to still have that functionality

So I can use that code you embedded above to replace these three (3) pieces of similar code (see below)?

Code: 
myList$ = Range("Approval_List").Address
Application.EnableEvents = False
With Range("I8")
   If Range("D9") = "Completed" Then
    .Validation.Modify Type:=xlValidateList, Formula1:="=" & myList
   Else
    .Validation.Modify Type:=xlValidateInputOnly
   End If
End With
Application.EnableEvents = True

myList$ = Range("Approval_List").Address
Application.EnableEvents = False
With Range("I22")
   If Range("D23") = "Completed" Then
    .Validation.Modify Type:=xlValidateList, Formula1:="=" & myList
   Else
    .Validation.Modify Type:=xlValidateInputOnly
   End If
End With
Application.EnableEvents = True

myList$ = Range("Approval_List").Address
Application.EnableEvents = False
With Range("I32")
   If Range("D33") = "Completed" Then
    .Validation.Modify Type:=xlValidateList, Formula1:="=" & myList
   Else
    .Validation.Modify Type:=xlValidateInputOnly
   End If
End With
Application.EnableEvents = True
 
Last edited:
The code in my post will work for all 3 range. Notice how UNION is used to check all 3.

Also, in iColChange sub, you will see how "NOW" is used to write datetime to the cell. "NOW" by itself is VBA equivalent of formula "=NOW()".

Using this method eliminates need to copy and paste as value.
 
You must log in or register to reply here.
Back
Top