Need help with VBA

[Ken]

Hi Group,
I have inserted some VBA on my spreadsheet that I gathered from
Excel tips, and it works very well, except for a minor problem.....I
have several different columns with drop down lists that if an entry
isn't on the list, one can type it in and it's added to the list and
automatically sorted, all with the VBA code....the one problem is that
when an entry is typed in and I hit enter, the cell beside the drop
down partially highlights, and if I enter any data into that cell, an
entry on my drop down list might be erased...I've been just clearing
the cell by deleting contents first before I enter any data into that
partially selected cell...it's hard to explain exactly, but I hope
that one can maybe understand the problem...this is the code, and
maybe it can be cleaned up some...the excel tip was for one dropdown
list, but I added 2 more drop downs (for Sheet 1 first):

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim ws As Worksheet
Dim i As Integer

Set ws = Worksheets("Lists")
If Target.Column = 4 And Target.Row > 1 Then
If Application.WorksheetFunction.CountIf(ws.Range("VALVETYPE"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("A" & i).Value = Target.Value
ws.Range("VALVETYPE").Sort Key1:=ws.Range("A1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

If Target.Column = 5 And Target.Row > 1 Then
If Application.WorksheetFunction.CountIf(ws.Range("MANUFACTURER"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("C" & i).Value = Target.Value
ws.Range("MANUFACTURER").Sort Key1:=ws.Range("C1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

If Target.Column = 12 And Target.Row > 1 Then
If Application.WorksheetFunction.CountIf(ws.Range("CONTACT"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("E" & i).Value = Target.Value
ws.Range("CONTACT").Sort Key1:=ws.Range("E1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

If Target.Column = 16 And Target.Row > 1 Then
If Application.WorksheetFunction.CountIf(ws.Range("REPAIRBIN"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("G" & i).Value = Target.Value
ws.Range("REPAIRBIN").Sort Key1:=ws.Range("G1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

There is other VBA code below the above code that is working very well
so I don't think that is a problem......now this is on Sheet 2, which
is named "Lists":

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Columns(1).Sort Key1:=Range("A1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
End Sub


Private Sub Worksheet_Change2(ByVal Target As Range)
Columns(1).Sort Key1:=Range("C1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
End Sub

Private Sub Worksheet_Change3(ByVal Target As Range)
Columns(1).Sort Key1:=Range("E1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
End Sub

I think the problem is with the "Lists" VBA, because I didn't know how
to change it to include more columns. If anyone can see the problem, I
would be very grateful for your help!!!
Thanks in advance...
Ken