Consulting

Results 1 to 11 of 11

Thread: IN VBA create a Data Vaildation List from a Case Selection

  1. #1

    IN VBA create a Data Vaildation List from a Case Selection

    is it possible to create a data Validation List from a Case Selection

    ie
    With Range("E9").Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="= Case X"
    'the X comes from Case
    Dim SectorType As Integer
    Worksheets("Input").Select
    SectorType = Range("T34").Value
    Select Case SectorType
    Case 1 = "='WORKSHEET#1'!$A$8:$J$8"
    Case 2 = "='WORKSHEET#2!$A$8:$J$8"
    End Select
    I'm struggling with this one

  2. #2
    VBAX Expert
    Joined
    Aug 2004
    Posts
    810
    Location
    how about this:
    Sub CreateValidation(CellLocation As Range, _
                         ValidationList As Variant, _
                         Optional sInputTitle As String, _
                         Optional sErrorTitle As String, _
                         Optional sInputMessage As String, _
                         Optional sErrorMessage As String)
        With Range(CellLocation.Address).Validation
            .Delete
            .Add Type:=xlValidateList, Formula1:=Join(ValidationList, ",")
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = sInputTitle
            .ErrorTitle = sErrorTitle
            .InputMessage = sInputMessage
            .ErrorMessage = sErrorMessage
            .ShowInput = True
            .ShowError = True
        End With
    End Sub
    Sub test()
        Dim ValList As Variant
        Dim lInput As Long
        
        lInput = InputBox("Enter a Number", , 1)
        Select Case lInput
            Case Is = 1
                ValList = Array("apple", "banana")
            
            Case Is = 2
                ValList = Array("beets", "squash")
        End Select
        CreateValidation ActiveSheet.Range("E9"), ValList
    End Sub

  3. #3
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    Sub M_snb() 
      Select Case InputBox("Enter a Number", , 1) 
      Case 1 
         c00 = "apple,banana" 
      Case 2 
         c00 = "beets,squash" 
      End Select 
      ActiveSheet.Range("E9").validation.modify 2,c00 
    End Sub
    or
    Sub M_snb() 
      on error resume next
      ActiveSheet.Range("E9").validation.modify 2,choose(InputBox("Enter a Number", , 1),"apple,banana","beets,squash") 
    End Sub

  4. #4
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    JKwan, I see you have the likes of:
    Sub CreateValidation(CellLocation As Range, _ ...
    where CellLocation is a range.

    Later you have:
    With Range(CellLocation.Address).Validation

    and I've seen this a few times today in other people's code.

    So why not:
    With CellLocation.Validation

    I can see a reason for the longer version (if the validation is to be applied to the active sheet range rather than a specific sheet range, for example), but was that the intention here? …maybe I'm missing a trick.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  5. #5

    I tried this and then I puller my hair out

    Sub CreateValidation(CellLocation As Range, _
        ValidationList As Variant, _
        Optional sInputTitle As String, _
        Optional sErrorTitle As String, _
        Optional sInputMessage As String, _
        Optional sErrorMessage As String)
        With Range(CellLocation.Address).Validation
            .Delete
            .Add Type:=xlValidateList, Formula1:=Join(ValidationList, ",")
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = sInputTitle
            .ErrorTitle = sErrorTitle
            .InputMessage = sInputMessage
            .ErrorMessage = sErrorMessage
            .ShowInput = True
            .ShowError = True
        End With
    Dim SectorType As Long
    Dim ValList As Variant
    SectorType = Range("T34")
    Select Case SectorType
    Case Is = 1
    ValList = Range("T41,T45")
    Case Is = 2
    ValList = Range("U41,U45")
    
    End Select
    CreateValidation ActiveSheet.Range("S41"), ValList
    End Sub
    **** I want the list to come from a range on the sheet ****
    Last edited by Aussiebear; 11-02-2013 at 12:17 AM. Reason: added code tags

  6. #6
    This accomplished what I was looking to do!!!!!!!!

    Sub Trythis()
     
    Dim rList As String
    Dim SectorType As Long
    SectorType = Range("T34")
    Select Case SectorType
    Case Is = 1
        rList = "$S$41:$S$45"
     
    Case Is = 2
        rList = "$T$41:$T$45"
        
    End Select
    With Range("s40")
        With .Validation
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=" & rList
        End With
    End With
    End Sub
    Last edited by Aussiebear; 11-02-2013 at 12:18 AM. Reason: added coge tags

  7. #7
    VBAX Expert
    Joined
    Aug 2004
    Posts
    810
    Location
    Quote Originally Posted by p45cal View Post
    JKwan, I see you have the likes of:
    Sub CreateValidation(CellLocation As Range, _ ...
    where CellLocation is a range.

    Later you have:
    With Range(CellLocation.Address).Validation

    and I've seen this a few times today in other people's code.

    So why not:
    With CellLocation.Validation

    I can see a reason for the longer version (if the validation is to be applied to the active sheet range rather than a specific sheet range, for example), but was that the intention here? …maybe I'm missing a trick.
    Why that is the case is that I removed the reference of the WORKSHEET. I did not think the op needed it, so I removed the code. I can pass a worksheet to create the Validation......

  8. #8
    Mac Moderator VBAX Guru mikerickson's Avatar
    Joined
    May 2007
    Location
    Davis CA
    Posts
    2,778
    Why use VBA, you can do this with names. Define a Name

    Name: myList ReferTo: =IF(Input!$A$4=1, WORKSHEET1!$A$8:$J$8, WORKSHEET2!$A$8:$J$8)

    And then set the List Source of the validation to =myList.

  9. #9
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,998
    Location
    @mikerickson. LOL Sometimes we forget that Microsoft programmers have already invented the wheel. ( Almost all of it )
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  10. #10
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Quote Originally Posted by JKwan View Post
    Why that is the case is that I removed the reference of the WORKSHEET. I did not think the op needed it, so I removed the code. I can pass a worksheet to create the Validation......
    but an object variable such as CellLocation doesn't need a worksheet ref., it already is a range on a specific sheet. So what is the advantage of Range(CellLocation.Address). over CellLocation. apart from the former being less robust being dependent on which sheet happens to be active at the time the code is run (unless this code is in a sheet's code module - in which case the longer version is superfluous anyway).
    At the moment I see no reason to detach the information that is within CellLocation (the worksheet) by using CellLocation.Address which contains no sheet information, to specify a range. Using the .Address property just seems to complicate matters. (Perhaps it's the inclusion in this variable's name of the word location which is implying (wrongly) that it is only a location of a range on a sheet rather than being the range itself?)

    To crystallise, would:
    With CellLocation.validation
    do the job?
    If yes, why not use it?

    I must be missing something.

  11. #11
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    if
    Sub Trythis() 
        Dim rList As String 
        Dim SectorType As Long 
        SectorType = Range("T34") 
        Select Case SectorType 
        Case Is = 1 
            rList = "$S$41:$S$45" 
             
        Case Is = 2 
            rList = "$T$41:$T$45" 
             
        End Select 
        With Range("s40") 
            With .Validation 
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ 
                xlBetween, Formula1:="=" & rList 
            End With 
        End With 
    End Sub
    accomplishes what you want, this will acomplish it too:

    Sub M_snb() 
        Range("s40").Validation.Add 3, 1, , "=" & range("$R$41:$R$45").offset(,Range("T34")).address 
    End Sub
    Eventually you will need:
    Private Sub Worksheet_Change(ByVal Target As Range)
        If Target.Address = "$T$34" Then Range("s40").Validation.Modify 3, 1, , "=" & Range("$R$41:$R$45").Offset(, Range("T34")).Address
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •