VBA for Custom Dropdown Lists

[JADownie]

I am trying to see if it would be possible to automate my workbook to create custom dropdown lists in the manner which I am describing below. Unfortunately I have not had much luck so any guidance would be greatly appreciated!!


I have sheet where I paste in a table from my output starting in Cell D4

There are multiple rows in Col D which contain a colon (“ : “) This may vary by job as some could have 5 and some could have 50.

For each row in Col D that has a colon, I need to format Cells B & C in the same row

In B I need a dropdown list with the options for Weekly and Monthly

In C I need a dropdown list with the options No Flex, 5% Flex and 10% Flex

I would also like the cells B & C in those rows to be colored yellow

 

[ekrause]

I think this is what you are looking for:

Sub VBACustomDropdowns()

NumberofLoopsVariable = Application.WorksheetFunction.CountA(Range("D:D"))

NumberofLoopsCompleted = 0

Set ColumnDLoop = Range("D:D")

For Each dCell In ColumnDLoop

dCell.Select

    If NumberofLoopsCompleted >= NumberofLoopsVariable Then
        Exit Sub
    Else
        If dCell = "" Then
            
        Else
            If InStr(1, dCell, ":") Then
                With dCell.Offset(0, -2)
                    .Validation.Delete
                    .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="Weekly, Monthly"
                    .Interior.ColorIndex = 27
                End With
                
                With dCell.Offset(0, -1)
                    .Validation.Delete
                    .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="No Flex, 5% Flex, 10% Flex"
                    .Interior.ColorIndex = 27
                End With
            Else
            
            End If
        NumberofLoopsCompleted = NumberofLoopsCompleted + 1
        End If
    End If

Next dCell

End Sub

I can jump back on and troubleshoot if I missed something in your original message.

 

[JADownie]

WOW Yes that worked exactly as desired!!

One follow-up question for you now would be is it possible to have this dropdown list default to Weekly?
.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="Weekly, Monthly"

Thanks again!!!

 

[JADownie]

I figured out a slightly convoluted way to do this for the one set of dropdown lists in Column B. But I am trying to see if I can default the 2nd set of dropdowns in Column C. And that completely tanks my macro below. Any advice for how to simply by adding a line to the original code above? THANKS a million in advance!!

I need the first set of dropdowns to default to "Weekly" and the second set to "No Flex"

My code that was working until now...

Sub DropDownList_ToDefault()
Dim oCell As Range

For Each oCell In ActiveSheet.UsedRange.Cells
If HasValidation(oCell) Then
oCell.Value = "Weekly"
End If
Next

Range("C4:C10000").Select
Selection.ClearContents
Range("A1").Select
End Sub

 

[ekrause]

I think this is what you are asking for:

Sub VBACustomDropdowns()

NumberofLoopsVariable = Application.WorksheetFunction.CountA(Range("D:D"))

NumberofLoopsCompleted = 0

Set ColumnDLoop = Range("D:D")

For Each dCell In ColumnDLoop

dCell.Select

    If NumberofLoopsCompleted >= NumberofLoopsVariable Then
        Exit Sub
    Else
        If dCell = "" Then
            
        Else
            If InStr(1, dCell, ":") Then
                With dCell.Offset(0, -2)
                    .Validation.Delete
                    .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="Weekly, Monthly"
                    .Interior.ColorIndex = 27
                End With
                
                dCell.Offset(0, -2) = "Weekly"
                
                With dCell.Offset(0, -1)
                    .Validation.Delete
                    .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="No Flex, 5% Flex, 10% Flex"
                    .Interior.ColorIndex = 27
                End With
                
                dCell.Offset(0, -1) = "No Flex"
            Else
            
            End If
        NumberofLoopsCompleted = NumberofLoopsCompleted + 1
        End If
    End If

Next dCell

End Sub