VBA code to populate a cell if a certain item is selected in another drop-down list; push this to 1400 rows

[jkalpus]

I recently created a private module that when "alcohol" is selected in cell Q3, then the text string "No nutritional value" is automatically entered into cell U3, and the text string "Over21/single" is entered into cell AA3. If "alcohol" is NOT selected in Q3, then U3 and AA3 have a drop-down list. So far so good.

NOW I need to do this same thing for the remaining 1400 alternating rows; in other words if this starts in Q3, then I need to do the same thing for Q5, Q7, Q9, thru row 1424.

To make it a little easier, the cell which contains "alcohol" in Q3, will now be Q5, Q7, etc., and the cells to automatically populate with "no nutritional value" and "Over 21/single" will be U3, U5, U7, etc., and AA3, AA5, AA7, etc. Each of the U and AA cells will pull their respective drop-down lists from named ranges of "HealthLevel_ValueToEater" and "WhatAgeGroupItsFor" respectively.

How do I do this? Should I declare a variable in my code which can be made to increment 2 cell addresses?

Here's my original code:


Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("Q3")) Is Nothing Then Exit Sub

If Target = "Alcohol" Then
With Range("U3")
.ClearContents
.Validation.Delete
.Value = "No nutritional value"
End With
Else
With Range("U3")
.ClearContents
.Validation.Delete
.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=HealthLevel_ValueToEater"
End With
End If


If Intersect(Target, Range("Q3")) Is Nothing Then Exit Sub

If Target = "Alcohol" Then
With Range("AA3")
.ClearContents
.Validation.Delete
.Value = "Over 21/Single"
End With
Else
With Range("AA3")
.ClearContents
.Validation.Delete
.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=WhatAgeGroupItsFor"
End With
End If



End Sub

 

[Fluff]

How about

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Intersect(Target, Range("Q3:Q1424")) Is Nothing Then Exit Sub
   If Application.IsEven(Target.Row) Then Exit Sub
   If Target = "Alcohol" Then
      With Range("U" & Target.Row)
         .ClearContents
         .Validation.Delete
         .Value = "No nutritional value"
      End With
      With Range("AA" & Target.Row)
         .ClearContents
         .Validation.Delete
         .Value = "Over 21/Single"
      End With
   Else
      With Range("U" & Target.Row)
         .ClearContents
         .Validation.Delete
         .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=HealthLevel_ValueToEater"
      End With
      With Range("AA" & Target.Row)
         .ClearContents
         .Validation.Delete
         .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=WhatAgeGroupItsFor"
      End With
   End If
End Sub

 

[My Aswer Is This]

edit
​

 

[jkalpus]

How about

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Intersect(Target, Range("Q3:Q1424")) Is Nothing Then Exit Sub
   If Application.IsEven(Target.Row) Then Exit Sub
   If Target = "Alcohol" Then
      With Range("U" & Target.Row)
         .ClearContents
         .Validation.Delete
         .Value = "No nutritional value"
      End With
      With Range("AA" & Target.Row)
         .ClearContents
         .Validation.Delete
         .Value = "Over 21/Single"
      End With
   Else
      With Range("U" & Target.Row)
         .ClearContents
         .Validation.Delete
         .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=HealthLevel_ValueToEater"
      End With
      With Range("AA" & Target.Row)
         .ClearContents
         .Validation.Delete
         .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=WhatAgeGroupItsFor"
      End With
   End If
End Sub

Thank you, Fluff! Works perfectly!!

 

[Fluff]

Glad to help & thanks for the feedback