Adding Data Validation using macro

[vk7]

Hello All,

I have two sheets, Sheet1 with a set of questions and Sheet2 (Hidden) with answers to Sheet1. Using a macro, I wanted to add Data Validation (with 'List' as Criteria) to the columns C, E, G, I and so on until the end of the data.

Any help would be appreciated.

 

[p45cal]

try:

Sub blah()
With Sheets("Sheet1").Range("C3:C12,E3:E12,G3:G12,I3:I12")
  .Validation.Delete
  .Validation.Add Type:=xlValidateList, Formula1:="=Sheet2!$A2:$F2"
  .Value = "Answer this Please"
End With
End Sub

I've taken a bit of a shortcut so some data validation cells will have a blank option as the bottommost choice.

 

[vk7]

@p45cal, thank you. I am also looking for a way to apply random answers to the questions on a button click for some evaluation. Each time, I run a macro it should select a different answer. Is that possible?

 

[p45cal]

get your button to run this macro (It will select a random answer each time, not necessarily a different answer):

Sub blah2()
For Each cll In Sheets("Sheet1").Range("C3:C12,E3:E12,G3:G12,I3:I12").Cells
  zz = Split(cll.Validation.Formula1, "=")(1)
  Set sss = Intersect(Range(zz), Range(zz).Offset(, 1))
  cll.Value = sss.Cells(Application.RandBetween(1, Application.CountA(sss))).Value
Next cll
End Sub

 

[p45cal]

Updated code blah from msg#2 to eliminate blank options:

Sub blah()
For Each cll In Sheets("Sheet1").Range("C3:C12,E3:E12,G3:G12,I3:I12").Cells
  With cll
    .Validation.Delete
    Set vrng = Range("Sheet2!$A1:$F1").Offset(cll.Row - 2)
    Set vrng = vrng.Resize(, Application.CountA(vrng))
    .Validation.Add Type:=xlValidateList, Formula1:="=" & Split(vrng.Address(False, True, , True), "]")(1)  '"=Sheet2!$A2:$F2"
    .Value = "Answer this Please"
  End With
Next cll
End Sub

Note that in the line:
Set vrng = Range("Sheet2!$A1:$F1").Offset(cll.Row - 2)
the F should be changed to the column letter of the rightmost column that contains the row with the largest number of choices. So if row 5 of sheet2 had choices up to cell J5, then that line would read:
Set vrng = Range("Sheet2!$A1:$J1").Offset(cll.Row - 2)

 

[vk7]

@p45cal, thanks a lot. It does what I wanted to do. Just a little more tweak if possible. This range Range("C3:C12,E3:E12,G3:G12,I3:I12") is dynamic. So is it possible to auto determine the range?

This is how manually it is done, If C2 or E2 or G2 and so on has "Answers" in it then the "Data Validation" is applicable.

 

[p45cal]

See attached.
Columns affected will be those with 'Answers' in row 2
Vertical extent controlled by the bottommost entry in coumn A.
Code in the file is:

Sub blah()
With Sheets("Sheet1")
  lr = .Cells(.Rows.Count, "A").End(xlUp).Row
  For Each celle In .Range(.Cells(2, "C"), .Cells(2, .Columns.Count).End(xlToLeft)).Cells
    If UCase(Trim(celle.Value)) = "ANSWERS" Then
      For Each cll In .Range(celle.Offset(1), .Cells(lr, celle.Column)).Cells
        With cll
          .Validation.Delete
          Set vrng = Range("Sheet2!$A1:$F1").Offset(cll.Row - 2)
          Set vrng = vrng.Resize(, Application.CountA(vrng))
          .Validation.Add Type:=xlValidateList, Formula1:="=" & Split(vrng.Address(False, True, , True), "]")(1)  '"=Sheet2!$A2:$F2"
          .Value = "Answer this Please"
        End With
      Next cll
    End If
  Next celle
End With
End Sub

Sub blah2()
With Sheets("Sheet1")
  lr = .Cells(.Rows.Count, "A").End(xlUp).Row
  For Each celle In .Range(.Cells(2, "C"), .Cells(2, .Columns.Count).End(xlToLeft)).Cells
    If UCase(Trim(celle.Value)) = "ANSWERS" Then
      For Each cll In .Range(celle.Offset(1), .Cells(lr, celle.Column)).Cells
        zz = Split(cll.Validation.Formula1, "=")(1)
        Set sss = Intersect(Range(zz), Range(zz).Offset(, 1))
        cll.Value = sss.Cells(Application.RandBetween(1, Application.CountA(sss))).Value
      Next cll
    End If
  Next celle
End With
End Sub