Help! Stop Users from corrupting Drop Down Box Macro

D

Dana M

Note - current code is at the bottom of this question. I'm not sure, but
think this is called a worksheet event?

In columns C and D of several sheets in a template, I have drop down boxes
for selecting Type and Owner. If the user selects a Type Name, a Type
Abbreviation is returned (from a hidden "Code" sheet), ie; select Apple,
template shows AP, select Jack Web, template returns JW. The Type and Owner
drop downs are adjacent, in Columns C and D, but are not in every row
because of subtotals and blank rows.

My problem - users sometimes key in "AP" instead of selecting
"Apple", or copy/paste "AP" from another row. These actions are causing
errors.

Is there a way to either revise the following code so that copy/paste or
keying in an "AP" gives the same result
as selecting Apple from the Drop Down? Or alternately, not allow the user to
do anything but select - with a message if they attempt - that they need to
select from the drop down options? Here is my
current code - on right click of the worksheet tab/show code /
.........................
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then GoTo exitHandler

If Target.Column = 3 Then
If Target.Value = "" Then GoTo exitHandler
Application.EnableEvents = False
Target.Value = Worksheets("Codes").Range("a1") _
.Offset(Application.WorksheetFunction _
.Match(Target.Value, Worksheets("Codes").Range("ExpType"), 0), 0)
End If
Application.EnableEvents = True

If Target.Cells.Count > 1 Then GoTo exitHandler

If Target.Column = 4 Then
If Target.Value = "" Then GoTo exitHandler
Application.EnableEvents = False
Target.Value = Worksheets("Codes").Range("d1") _
.Offset(Application.WorksheetFunction _
.Match(Target.Value, Worksheets("Codes").Range("ExpOwner"), 0), 0)

End If
exitHandler:
Application.EnableEvents = True
Exit Sub

errHandler:
If Err.Number = 13 Or Err.Number = 1004 Then
GoTo exitHandler
Else
Resume Next
End If

End Sub
 
J

Jim Cone

You don't say what type of dropdown you use and you didn't
mention the xl version. If you had said xl2007, I would have
ignored your post and you would be one of the lucky ones this time. <g>

Some ideas (some not that good)...
1. Use dropdowns (comboboxes) from the "Control Tool Box".
They have a "ComboBox_Change" event that is separate from the
Worksheet_Change event.
2. Place all of your linked cells in the same column and check that
the change occurs in that column. If not, exit code.
3. Use Data Validation lists in the appropriate cells -
no change event necessary.
4. Lock the cells, so the user can't change them.
In your code, unlock the cells, do things, lock the cells.
(the linked cells, must remain unlocked)
--
Jim Cone
Portland, Oregon USA



"Dana M"
<[email protected]>
wrote in message
Note - current code is at the bottom of this question. I'm not sure, but
think this is called a worksheet event?
In columns C and D of several sheets in a template, I have drop down boxes
for selecting Type and Owner. If the user selects a Type Name, a Type
Abbreviation is returned (from a hidden "Code" sheet), ie; select Apple,
template shows AP, select Jack Web, template returns JW. The Type and Owner
drop downs are adjacent, in Columns C and D, but are not in every row
because of subtotals and blank rows.

My problem - users sometimes key in "AP" instead of selecting
"Apple", or copy/paste "AP" from another row. These actions are causing
errors.

Is there a way to either revise the following code so that copy/paste or
keying in an "AP" gives the same result
as selecting Apple from the Drop Down? Or alternately, not allow the user to
do anything but select - with a message if they attempt - that they need to
select from the drop down options? Here is my
current code - on right click of the worksheet tab/show code /
.........................
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then GoTo exitHandler
If Target.Column = 3 Then
If Target.Value = "" Then GoTo exitHandler
Application.EnableEvents = False
Target.Value = Worksheets("Codes").Range("a1") _
.Offset(Application.WorksheetFunction _
.Match(Target.Value, Worksheets("Codes").Range("ExpType"), 0), 0)
End If
Application.EnableEvents = True
If Target.Cells.Count > 1 Then GoTo exitHandler
If Target.Column = 4 Then
If Target.Value = "" Then GoTo exitHandler
Application.EnableEvents = False
Target.Value = Worksheets("Codes").Range("d1") _
.Offset(Application.WorksheetFunction _
.Match(Target.Value, Worksheets("Codes").Range("ExpOwner"), 0), 0)
End If
exitHandler:
Application.EnableEvents = True
Exit Sub
errHandler:
If Err.Number = 13 Or Err.Number = 1004 Then
GoTo exitHandler
Else
Resume Next
End If
End Sub
 
D

Dana M

Thanks for you ideas - I'm going to try them. Sorry for not saying that I'm
using Excel 2003, and I'm using Data Validation Drop Downs - settings: Allow
List, Source = ExpType, (a range name on a wksheet named Codes), Warning
after invalid data is entered "Please enter Exp Type before entering data."
 
D

Dana M

Jim, since I haven't done Combo Boxes before and since I've already got the
current drop downs on several pages in the worksheets and since users like
the way it works (as long as they click select) I thought I'd try your fix
#4, but I can't get it to work. Here's how I added my "unprotect" and "
protect" code to the original Worksheet Code. Note: I put ** in front of the
new code below - of course, there are no asteriks in the actual worksheet
code.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then GoTo exitHandler

If Target.Column = 3 Then
**ActiveSheet.Unprotect "mypassword"
If Target.Value = "" Then GoTo exitHandler
Application.EnableEvents = False
Target.Value = Worksheets("Codes").Range("a1") _
.Offset(Application.WorksheetFunction _
.Match(Target.Value, Worksheets("Codes").Range("ExpType"), 0), 0)
End If
Application.EnableEvents = True

If Target.Cells.Count > 1 Then GoTo exitHandler

If Target.Column = 4 Then
**ActiveSheet.Unprotect "mypassword"
If Target.Value = "" Then GoTo exitHandler
Application.EnableEvents = False
Target.Value = Worksheets("Codes").Range("d1") _
.Offset(Application.WorksheetFunction _
.Match(Target.Value, Worksheets("Codes").Range("ExpOwner"), 0), 0)

End If
exitHandler:
Application.EnableEvents = True
Exit Sub

errHandler:
If Err.Number = 13 Or Err.Number = 1004 Then
GoTo exitHandler
Else
Resume Next
End If
**ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingColumns:=True, Password:="mypassword"
End Sub
 
J

Jim Cone

Protecting validated entries is a recurring subject in the newsgroup
and there is no perfect answer.
See if the following gets you closer...
'--
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vReturn As Variant
If Target.Cells.Count > 1 Then
GoTo exitHandler
ElseIf Target.Value = "" Then
GoTo exitHandler
ElseIf Target.Column = 3 Then
Application.EnableEvents = False
vReturn = Application.Match(Target.Value, _
Worksheets("Codes").Range("ExpType"), 0)
'Not in the list
If IsError(vReturn) Then
Application.Undo
MsgBox "Don't do that, use the dropdown. "
Else
Target.Value = Worksheets("Codes").Range("a1") _
.Offset(Application.WorksheetFunction _
.Match(Target.Value, Worksheets("Codes").Range("ExpType"), 0), 0)
End If
ElseIf Target.Column = 4 Then
Application.EnableEvents = False
vReturn = Application.Match(Target.Value, _
Worksheets("Codes").Range("ExpOwner"), 0)
'Not in the list
If IsError(vReturn) Then
Application.Undo
MsgBox "Don't do that, use the dropdown. "
Else
Target.Value = Worksheets("Codes").Range("d1") _
.Offset(Application.WorksheetFunction _
.Match(Target.Value, Worksheets("Codes").Range("ExpOwner"), 0), 0)
End If
End If
exitHandler:
Application.EnableEvents = True
Exit Sub
errHandler:
If Err.Number = 13 Or Err.Number = 1004 Then
GoTo exitHandler
Else
Resume Next
End If
End Sub
--
Jim Cone
Portland, Oregon USA




"Dana M"
<[email protected]>
wrote in message
Jim, since I haven't done Combo Boxes before and since I've already got the
current drop downs on several pages in the worksheets and since users like
the way it works (as long as they click select) I thought I'd try your fix
#4, but I can't get it to work. Here's how I added my "unprotect" and "
protect" code to the original Worksheet Code. Note: I put ** in front of the
new code below - of course, there are no asteriks in the actual worksheet
code.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then GoTo exitHandler

If Target.Column = 3 Then
**ActiveSheet.Unprotect "mypassword"
If Target.Value = "" Then GoTo exitHandler
Application.EnableEvents = False
Target.Value = Worksheets("Codes").Range("a1") _
.Offset(Application.WorksheetFunction _
.Match(Target.Value, Worksheets("Codes").Range("ExpType"), 0), 0)
End If
Application.EnableEvents = True

If Target.Cells.Count > 1 Then GoTo exitHandler

If Target.Column = 4 Then
**ActiveSheet.Unprotect "mypassword"
If Target.Value = "" Then GoTo exitHandler
Application.EnableEvents = False
Target.Value = Worksheets("Codes").Range("d1") _
.Offset(Application.WorksheetFunction _
.Match(Target.Value, Worksheets("Codes").Range("ExpOwner"), 0), 0)

End If
exitHandler:
Application.EnableEvents = True
Exit Sub

errHandler:
If Err.Number = 13 Or Err.Number = 1004 Then
GoTo exitHandler
Else
Resume Next
End If
**ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingColumns:=True, Password:="mypassword"
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Drop Down Boxes with Macro 0
Multiple entries from a drop down list 2
Data Val MultiSelect ? 1
Drop down errors 0
drop down deletion errors 1
how to have 2 drop down lists filter rows 2
Create multiple dropdown list for multiple colums; select more tha 0
Pick multiple items from list box 5

Top