Solved: Dynamic Drop Down List Freezing

[GregB]

Hello all,

I am stumped on how to fix my code. The code works 'properly', until an end user decides to paste instead of entering data manually.

The purpose of the code is to allow end users to add new values to drop down lists in excel.

The description of the setup is as follows:

Dynamic named ranges are defined in excel by going to Insert -> Name -> Define -> and then this offset function is the list reference:
=OFFSET(Sheet1!$A$2,0,0,COUNTA(Sheet1!$A$2:$A$100),1)

An additional named range is added also.

Then VBA is used so that the end user can add values that aren't included in the original list:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False

Dim cell As Range
Dim lReply As Long

If Target.Column = 4 Then

For Each cell In Range("$D$2:$D$100")

If IsEmpty(cell) Then Exit Sub

If WorksheetFunction.CountIf(Range("ColorsList"), cell) = 0 Then

lReply = MsgBox("Add " & cell & " to list", vbYesNo + vbQuestion)

If lReply = vbYes Then

Range("ColorsList").Cells(Range("ColorsList").Rows.Count + 1, 1) = cell

End If

End If

Next

ElseIf Target.Column = 5 Then

For Each cell In Range("$E$2:$E$100")

If IsEmpty(cell) Then Exit Sub

If WorksheetFunction.CountIf(Range("MetalList"), cell) = 0 Then

lReply = MsgBox("Add " & cell & " to list", vbYesNo + vbQuestion)

If lReply = vbYes Then

Range("MetalList").Cells(Range("MetalList").Rows.Count + 1, 1) = cell

End If

End If

Next

End If
Application.ScreenUpdating = True

End Sub


But if the end user decides they want to copy and paste values, especially from section of a column to another section of the same column, the vba code seems to just freeze or hang.

If I could prevent pasting into those particular columns, that would be good. But it would be even better if the freezing could be resolved and the end user could copy and paste.

A sample workbook is attached.


Thanks!

-Greg

[mdmackillop]

A common problem with Event macros where more than one cell is selected.

Near the start of your code add the line

If Target.Cells.Count >1 then Exit Sub

[GregB]

Mdmackillop, I thank you so much for your reply!
I have added If Target.Cells.Count >1 Then Exit Sub but I'm still getting frozen when I try to copy and paste. Any more ideas?

[mdmackillop]

I can't reproduce your problem. Here's an alternative code to try

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Target.Cells.Count > 1 Then Exit Sub
Select Case Target.Column
Case 4
Set c = Range("ColorsList").Find(Target, lookat:=xlWhole)
If c Is Nothing Then Call AddData(1, Target)
Case 5
Set c = Range("MetalList").Find(Target, lookat:=xlWhole)
If c Is Nothing Then Call AddData(2, Target)
End Select
End Sub


Sub AddData(col, Target)
Dim lReply As Long
lReply = MsgBox("Add " & Target & " to list", vbYesNo + vbQuestion)
If lReply = vbYes Then
Cells(Rows.Count, col).End(xlUp)(2) = Target
End If
End Sub

[GregB]

I've tested your code and as far as I can tell -- IT WORKS! THANKS A MILLION!!:beerchug: Now I will see if I can help anyone else out around here.