Drop Down Boxes with Macro

[Dana M]

With advice from this user group, I have created a planning template with
many worksheets and summary sheets. Because there are macros and range
names, I've password protected the workbook to avoid users inadvertently
corrupting macros or formulas. In columns C and D of several sheets, I have
drop down boxes for selecting Type and Owner. If the user selects a Type
Name, a Type Abbreviation is returned, ie; select Apple, template shows AP.
The two boxes are adjacent, as I said, Columns C and D, but are not in every
row because of subtotals and bland rows. First problem I got - if a user
clicked or typed in a blank row in column C or D, they would get an error
message, and the substitutions would cease, now the template would return
Apple, not A. Then, impatient users began to key in "A" instead of selecting
"Apple", or copy/paste A from a row above that may have been selected.
Either would cause errors, which were then also corrupting ranges - don't
know why. I fixed the "click" type errors by Locking all cells in columns C
& D except the data entry cells before protecting. However, the keying in or
copy/paste errors continue in the data entry cells. Is there a way to either
revise the code so that copy/paste or keying in an "A" gives the same result
as selecting A from the Drop Down? Or alternately, and just as preferable,
not allowing 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