VBA to Reset multiple Data Validation lists to first entry in list

[Sheripres]

Hello:
I found a VBA code that was strictly for lists and would not work for me. My data validation lists/drop downs are created with many formulas and some that are just lists.
After the end user creates the part number through the various drop downs, they push a button and it pastes on another sheet tab.
Now, I want to reset what they put on the Form sheet tab so they can start over. I will just create another form button.

Thank you for any help.

Sheri

 

[Akuini]

Sorry, I don't know what list separator you're using. Is it comma or semicolon? If it is comma then replace:

ListCell.Value = Split(ListCell.Validation.Formula1, ";")(0)

with:

ListCell.Value = Split(ListCell.Validation.Formula1, ",")(0)

 

[Sheripres]

I think you're using string as the list., something like: apel;lemon;banana
Try this one:

Sub ResetDropDowns_1()

Dim rngLists As Range
Dim ListCell As Range
Dim c As Range

On Error Resume Next
Set rngLists = ActiveSheet.UsedRange.SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0

If Not rngLists Is Nothing Then
    For Each ListCell In rngLists.Cells
            If IsError(Evaluate(ListCell.Validation.Formula1)) Then
                ListCell.Value = Split(ListCell.Validation.Formula1, ";")(0)
            Else
                Set c = Evaluate(ListCell.Validation.Formula1)
                If Not c Is Nothing Then ListCell.Value = c.Cells(1)
            End If
    Next ListCell
End If

End Sub

Almost there! Works perfectly for the IF statements, but the first validation list combines all three choices instead of just CHOOSE THERMOSTAT MODEL.

If there is not a fix for it, I can create a fake IF statement for this somehow.

THANK YOU so much for helping!

 

[Akuini]

If there is not a fix for it, I can create a fake IF statement for this somehow.

Check post #21, you need to change semicolon into comma.

 

[Sheripres]

I think you're using string as the list., something like: apel;lemon;banana
Try this one:

Sub ResetDropDowns_1()

Dim rngLists As Range
Dim ListCell As Range
Dim c As Range

On Error Resume Next
Set rngLists = ActiveSheet.UsedRange.SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0

If Not rngLists Is Nothing Then
    For Each ListCell In rngLists.Cells
            If IsError(Evaluate(ListCell.Validation.Formula1)) Then
                ListCell.Value = Split(ListCell.Validation.Formula1, ";")(0)
            Else
                Set c = Evaluate(ListCell.Validation.Formula1)
                If Not c Is Nothing Then ListCell.Value = c.Cells(1)
            End If
    Next ListCell
End If

End Sub

GOT IT! I just had to change the ";" to "," since it was a string.

Thank you so much!!! This is a life saver for me!

 

[Akuini]

GOT IT! I just had to change the ";" to "," since it was a string.

Thank you so much!!! This is a life saver for me!

You're welcome, glad to help & thanks for the feedback.