Run a macro to generate a drop down list

[Gidu]

I used this macro:

Sub test3()

Dim x As String

On Error Resume Next
x = Range("$A$1:$A$10").Validation.Formula1

If Err.Number = 0 Then
'validation exists
Range("$a$1:$a$10").Validation.Delete
End If

On Error GoTo 0

Range("$a$1:$a$10").Validation.Add xlValidateList, xlValidAlertStop, xlBetween, "=$c$1:$c$5"

End Sub


It works fine until a user moves one of the cells between A1 and A10 to somewhere outside the A1:A10 range; leaving the cell without a drop down list. I would run the above macro again; hoping to generate a drop down list to replace the moved cell, and that's when the runtime 1004 error appears.

In short, I am trying to make A1 to A10 maintain dropdown lists even if one of the cells gets moved. Maybe by automatically replacing the empty cell with a new dropdown list. Any ideas? Thanks in advance.

 

[Ekim]

First thing that I would do is to protect the worksheet to stop users moving the cells in the first place.

Select cells A1:A10.
Go to the Format menu | Cells | Protection tab
Uncheck the “Lock” checkbox
OK

Then go to the Tools menu | Protection.

If protection is not desirable, then put the following macro into the relevant sheet module e.g. if Sheet1 is the active sheet, then put the macro into the Sheet1 module:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then

With Range("A1:A10").Validation
 .Delete
End With

Range("$a$1:$a$10").Validation.Add xlValidateList, xlValidAlertStop, xlBetween, "=$c$1:$c$5"
End If
End Sub

If a cell is moved out of A1:A10, the above macro will automatically recreate the validation cells.

 

[Tom Urtis]

When you say a cell is getting moved, I assume you mean someone is dragging that cell and dropping it somewhere else on the spreadsheet. If that's the case, first you should delete any hence-superfluous data validated cells that have been dragged & dropped all over creation. If I were you, I'd try this as a deterrent to prevent dragging & dropping, and see if it solves your dilemma:

Right click on your sheet tab, left click on View Code, and paste the following procedure into the large white area that is the worksheet module. Press Alt+Q to return to the worksheet.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("A1:A10")) Is Nothing Then
Application.CellDragAndDrop = True
Else
Application.CellDragAndDrop = False
End If
End Sub

 

[Jaafar Tribak]

Hi,

Unless I am missing something, you could simply use this alternative code:

Sub test3()
    On Error Resume Next
    Range("$a$1:$a$10").Validation.Delete
    Range("$a$1:$a$10").Validation.Add xlValidateList, xlValidAlertStop, xlBetween, "=$c$1:$c$5"
End Sub

HTH

 

[Gidu]

I thank you all for your speedy responses. All of the suggestions worked as they were supposed to; however, a new problem occurred after implementing the code.

First off, Ekim, you are right, protection is not desired for the drop down lists but, portions of the sheet will be protected. The end users need to be able to highlight the cells and drag/drop the drop down lists over other drop down lists around the worksheet. This is where the new problem occurs. (Note to Tom Urtis: Though I didn’t need your suggestion for preventing drag/drop for this code; I did however, need it for another project I have going. Thanks for the extra treat.)

After reading all the suggestions, I went with the following code:

Sub test3()
On Error Resume Next
Range("$a$1:$a$10").Validation.Delete
Range("$a$1:$a$10").Validation.Add xlValidateList, xlValidAlertStop, xlBetween, "=$c$1:$c$5"
End Sub
_______________________________________________________________________
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 10 Then Exit Sub
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then

With Range("A1:A10").Validation
.Delete
End With


Range("$a$1:$a$10").Validation.Add xlValidateList, xlValidAlertStop, xlBetween, "=$c$1:$c$5"

End If
End Sub


So there it is, code loaded, A1:A10 and C1:C5 are unlocked, and protection is enabled. The moment a selection is made in one of the drop down lists (a1:a10), a run time error ‘-2147417848 (80010108)’ Method ‘Add’ of object ‘Validation’ failed appears. The Debug option highlights:

Range("$a$1:$a$10").Validation.Add xlValidateList, xlValidAlertStop, xlBetween, "=$c$1:$c$5"

Now, the entire drop down lists in a1:a10 disappear. I read that Tom Urtis had a similar runtime error. I tried closing down excel and restarting the worksheet, making a whole new worksheet, and even rebooting. Any fixes for this? Thanks in advance. (Note: using Excel 2003 with XP Pro)

 

[Ekim]

Gidu,

I don’t know why you are getting a run time error message .The two macros that you refer to have been re-tested, and both worked perfectly (Using Excel XP/Win 2002).

A search of the Microsoft knowledge base revealed three references to “Run-time error '-2147417848 (80010108)”, none of which appear relevant to your problem:

XL2000: Error Message: "Automation Error: The Object Invoked Has Disconnected from Its Clients"
http://support.microsoft.com/default.aspx?kbid=813120
CAUSE
This problem occurs because the HPageBreaks.Add object does not check buffer size, and there is a mis-match between a large buffer size of the DEVMODE structure of your default printer driver and the DEVMODE structure of your Excel workbook.

Issues that are fixed in Excel 2002 by Office XP Service Pack 3
http://support.microsoft.com/default.aspx?scid=kb;en-us;836031
Using the VBA HPageBreaks.Add method may cause the above run-time error message in Excel XP.

BUG: Run-Time Error Message -2147417848 (80010108) When Passing Array of Dictionary Objects
http://support.microsoft.com/default.aspx?scid=kb;en-us;270589
SYMPTOMS
You have a Visual Basic ActiveX DLL that has a method that takes an array of Scripting Dictionary Objects as an argument.

Do you have any macros in your workbook that are remotely connected to anything mentioned in the above references?

Regards,

Mike

 

[Cbrine]

Just a thought.
If you are changing the values in A1:A10 on the change of any values within A1:A10, wouldn't this trigger a change event in A1:A10. Sounds like an endless loop to me.

Try encapsulating your change event code with this. This should stop the 2nd event trigger from occurring.

Application.enableevents = false
Your code...
Application.enableevents =True

HTH

 

[Gidu]

Once again; Ekim, you are correct that the run time errors showcased on the microsoft site have nothing to do with my problem. Also, the two macros do run perfectly on Excel XP and 2003 using Win XP Pro but, only when the sheet is unprotected.

Cbrine, your suggestion gets rid of the run time error but, it cancels out the code that generates a new drop down list. This is not what I desire to happen.

Since the error only occurs when the sheet is protected, it is the protection that needs to be dealt with.

I went with the following code. It is an easy way out for this dilemma but, it does work. Unfortunately; when the sheet is unprotected, dragging and dropping (or even selecting a value) any of the drop down lists in the A1:A10 range results in the sheet automatically becoming protected.

Sub test3()
On Error Resume Next
Range("$a$1:$a$10").Validation.Delete
Range("$a$1:$a$10").Validation.Add xlValidateList, xlValidAlertStop, xlBetween, "=$c$1:$c$5"
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 10 Then Exit Sub
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
Worksheets("Sheet1").Unprotect Password:=""

With Range("A1:A10").Validation
.Delete
End With


Range("$a$1:$a$10").Validation.Add xlValidateList, xlValidAlertStop, xlBetween, "=$c$1:$c$5"
Range("$a$1:$a$10").Locked = False
End If
Worksheets("Sheet1").Protect Password:=""

End Sub

I would of thought the following code would of done just as good as the one above and prevented the likelihood of the password being revealed (and automactically setting the sheet into protection mode) but, it did not work.

Sub test3()
On Error Resume Next
Range("$a$1:$a$10").Validation.Delete
Range("$a$1:$a$10").Validation.Add xlValidateList, xlValidAlertStop, xlBetween, "=$c$1:$c$5"
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 10 Then Exit Sub
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
Worksheets("Sheet1").Protect userinterfaceonly:=True

With Range("A1:A10").Validation
.Delete
End With


Range("$a$1:$a$10").Validation.Add xlValidateList, xlValidAlertStop, xlBetween, "=$c$1:$c$5"
Range("$a$1:$a$10").Locked = False
End If
Worksheets("Sheet1").Protect Password:=""

End Sub

Does anyone have suggestions for the protection problem in these codes?

Thank you all again for your responses.