Macro Slow

[WindowGuy]

Hi There. I am not good at this so please bare with me. I copied the following code from the internet to reset all my dropdownlist but it is SOOOOO slow. Like literally 4+ minutes to reset my page. I created myself a quoting program for my small business and would like to default to start fresh again on all dropdown lists. please help and see what i copied and used which is slow. Again i barely understand this so easy on my with terms of answers.

Sub DropDownListToDefault()
    Dim oCell As Range
   
    For Each oCell In ActiveSheet.UsedRange.Cells
        If HasValidation(oCell) Then
            oCell.Value = "'- Choose Option -"
            End If
    Next
   
End Sub

Function HasValidation(cell As Range) As Boolean
    Dim t: t = Null
   
    On Error Resume Next
    t = cell.Validation.Type
    On Error GoTo 0
   
    HasValidation = Not IsNull(t)
End Function

Thanks in advance.

George.

 

[Anfinsen]

Hey there, try this, see if it speeds things up.

Sub DropDownListToDefault()
Application.Calculation = xlManual
Application.ScreenUpdating = False


Dim oCell As Range

For Each oCell In ActiveSheet.UsedRange.Cells
If HasValidation(oCell) Then
oCell.Value = "'- Choose Option -"
End If
Next

End Sub

Function HasValidation(cell As Range) As Boolean
Dim t: t = Null

On Error Resume Next
t = cell.Validation.Type
On Error GoTo 0

HasValidation = Not IsNull(t)

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True


End Function

 

[WindowGuy]

Hey there, try this, see if it speeds things up.

Sub DropDownListToDefault()
Application.Calculation = xlManual
Application.ScreenUpdating = False


Dim oCell As Range

For Each oCell In ActiveSheet.UsedRange.Cells
If HasValidation(oCell) Then
oCell.Value = "'- Choose Option -"
End If
Next

End Sub

Function HasValidation(cell As Range) As Boolean
Dim t: t = Null

On Error Resume Next
t = cell.Validation.Type
On Error GoTo 0

HasValidation = Not IsNull(t)

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True


End Function

at 8+ minutes and still going definetley not better

 

[dreid1011]

at 8+ minutes and still going definetley not better

How many dropdown lists are on the sheet?

 

[Fluff]

How about

Sub DropDownListToDefault()
   Dim Rng As Range
   
   Application.ScreenUpdating = False
   On Error Resume Next
   Set Rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeAllValidation)
   Rng.Value = "'- Choose Option -"
   On Error GoTo 0
End Sub

 

[WindowGuy]

How many dropdown lists are on the sheet?

about 300.... at 20 mins from the last guys sugestion definetly worse. i dont know how to stop it i tried the window key+end but it's not doing anything....

 

[WindowGuy]

How about

Sub DropDownListToDefault()
   Dim Rng As Range
  
   Application.ScreenUpdating = False
   On Error Resume Next
   Set Rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeAllValidation)
   Rng.Value = "'- Choose Option -"
   On Error GoTo 0
End Sub

you my friend are a genius. It was instant. Unbelievable thank you so much you have no idea how happy I am.. Now anyway to make it work when sheet protected?

 

[Fluff]

You will need to unprotect the sheet at the start of the code & re-protect it at the end.

 

[WindowGuy]

You will need to unprotect the sheet at the start of the code & re-protect it at the end.

Hi there is there no other way? I want to give this sheet to an assistant to use for quoting but cant unlock it for them i need it to stay locked.

 

[WindowGuy]

Hi there is there no other way? I want to give this sheet to an assistant to use for quoting but cant unlock it for them i need it to stay locked.

You will need to unprotect the sheet at the start of the code & re-protect it at the end.

Hi There i found it on youtube. Again thank you for all your help.

Using Macro on Protected sheet

George