CODEWITHSUNDEEP
excelvba
Kolka
Kolka

Reputation: 13

Datavalidation with IF stament in VBA for differenet rows

I would like to create a dropdown in Excel on Sheet1 if in the row any cells conatins a an expression (Here is the example of "PBE"), then an extended dropdown list will be available.

(The extension worked without if)

    Option Explicit

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim i As Long
Dim a$, el As Range
Dim a1 As Range
Dim rng1 As Range, rng2 As Range
Set rng1 = Worksheets("OptionList").Range("E8:E48") 'Base list
Set rng2 = Worksheets("OptionList").Range("K2:K3") 'IF in the row the list contains PBE add to the selection this list as

      If Not Intersect(Target, Target.Worksheet.Range("A2")) Is Nothing Then
For Each el In rng1 'first range
    a = a & el.Value & ","
Next
For Each el In rng2 '2nd range but only if the row contains
    a1 = a & el.Value & ","
Next
      For i = 68 To 78

   If Worksheets("Sheet1").Range(Cells(i, 19), Cells(i, 48)).Find("PBE") Is Nothing Then

   With Worksheets("Sheet1").Range(Cells(i, 19), Cells(i, 48)).Validation 'destination val.list (without PBA)
       .Delete
       .Add Type:=xlValidateList, Formula1:=a
     End With
      Else
      With Worksheets("Sheet1").Range(Cells(i, 19), Cells(i, 48)).Validation 'destination val.list with PBA
    .Delete
    .Add Type:=xlValidateList, Formula1:=a1
       End If

      Next i
      End If
      Set rng1 = Nothing
      Set rng2 = Nothing

     End Sub

It is not working line by line, but for all the lines which are targeted by i. So I mean if anywere in the big range there is a PBE word not line, by line it trigers the exteneded dropdown menu.

Upvotes: 1

Views: 55

Answers (1)

PeterT
PeterT

Reputation: 8557

There are some simplications we can make to the code in order to make it more maintainable and straightforward.

My first suggestion is to make your very first statement the check if your SelectionChange is your target cell. This is more efficient because no other logic or code is executed when it's not necessary.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    '--- add data validation only if the XXXXXX cell isn't empty
    If Not Intersect(Target, Range("A2")) Is Nothing Then
       ...
    End If
End Sub

Next, you're confusing yourself (and me) with references to worksheets. This code is intended to execute when the user changes the selected cell on Sheet1, but then you're referring to the OptionList worksheet. Use descriptive variable names and explicitly define variables so there's no confusion in the worksheet or range you're referencing.

Dim optionWS As Worksheet
Set optionWS = ThisWorkbook.Sheets("OptionList")

Dim listData As Range
Set listData = optionWS.Range("E8:E48")

Instead of looping to create your comma separated list, you can use the Join function in a single line:

Dim baseList As String
baseList = Join(Application.Transpose(listData.Value), ",")

Dim extendedList As String
Set listData = optionWS.Range("K2:K3")
extendedList = baseList & "," & Join(Application.Transpose(listData.Value), ",")

One source of confusion when reading your code was the continued/repeated reference to Worksheets("Sheet1").Range(Cells(i, 19), Cells(i, 48)). When this happens, it's far easier to create a specific variable that refers to that range. It also makes it very clear what the size of the range is...

Dim dropDownRange As Range
Set dropDownRange = ActiveSheet.Range("S68").Resize(10, 29)

So now it's just a matter of looping over each row in that range and checking for your PBE string.

Dim checkRow As Range
For Each checkRow In dropDownRange.Rows
    With checkRow
        If .Find("PBE") Is Nothing Then
            .Validation.Delete
            .Validation.Add Type:=xlValidateList, Formula1:=baseList
        Else
            .Validation.Delete
            .Validation.Add Type:=xlValidateList, Formula1:=extendedList
        End If
    End With
Next checkRow

Here's the whole module:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    '--- add data validation only if the XXXXXX cell isn't empty
    If Not Intersect(Target, Range("A2")) Is Nothing Then
        Dim optionWS As Worksheet
        Set optionWS = ThisWorkbook.Sheets("OptionList")

        Dim listData As Range
        Set listData = optionWS.Range("E8:E48")

        Dim baseList As String
        baseList = Join(Application.Transpose(listData.Value), ",")

        Dim extendedList As String
        Set listData = optionWS.Range("K2:K3")
        extendedList = baseList & "," & Join(Application.Transpose(listData.Value), ",")

        Dim dropDownRange As Range
        Set dropDownRange = ActiveSheet.Range("S68").Resize(10, 29)

        Dim checkRow As Range
        For Each checkRow In dropDownRange.Rows
            With checkRow
                If .Find("PBE") Is Nothing Then
                    .Validation.Delete
                    .Validation.Add Type:=xlValidateList, Formula1:=baseList
                Else
                    .Validation.Delete
                    .Validation.Add Type:=xlValidateList, Formula1:=extendedList
                End If
            End With
        Next checkRow
    End If
End Sub

Upvotes: 1

Related Questions