Another Macro Problem

  • Thread starter Thread starter John Kitchens
  • Start date Start date
J

John Kitchens

I have another macro question. I have a macro that I have modified numerous
times, and now it works great, BUT I am having one problem.

I am using Data Validation to alphabetically sort three lists that I have on
the Lists sheet. On Sheet 1 cell I5 I either select a current vendor from
the list, or I add a new vendor to the list.

I tried using data validation and having this applied all the way down to
cell I40.

I can select the current info, but on the cells I6:I40 I can't add new info.
I can only add new vendors in the I5 Cell.

Below is a section of my macro. I think the problem is b/c of Target.Address
line. It has "$I$5" in it, and I assume that is why it won't let me enter
new info on any other line except for the I5 cell.

I tried changing it to "$I$5:$i$40" but that didn't work.

Set ws = Worksheets("Lists")
If Target.Address = "$I$5" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If


Any help will be greatly appreciated.

Sincerely,

John Kitchens
 
Could it be that you want something like this:

if intersect(target, me.range("i5:i40")) is nothing then exit sub

(But I'm not sure how you're running this code. If that suggestion isn't
correct, maybe posting a little more of the code -- including how it's called.)
 
Hello Dave,

Thanks for your reply. I have posted the complete macro below.

I know there has got to be a better way than what I have done.

I am using Excel 2000. On sheet 1 cell G5-G40 and sheet 1 cell I5-I40 the
user will either select names from the current list (made named lists and
data validtion) or type in a new name. These names that are typed in will be
sorted alphabetically.

The problem that I was having is that the user could only enter in a new
name in cell G5 or cell I5. They could select existing names from the list
from cell g5-g40 and I5-I40 but if they were on cell G15 they couldn't add a
new name to the list.

Therefore I had to make this extremely long macro. Now it works but this
file has now grown to about 146K. Way to big.

I am just learning VBA, but I would think there has to be a way that I could
program it so that it will combine G5-G40 and then I5-I40 without having to
have so many lines of code.

Of course I may be way off. Like I said I am about as green as they come,
but I am slowly learning and understanding, and I admire and respect all of
you guys that so selfishly help all of us novices. Thank you for that.

Sincerely,
John Kitchens

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.Address = "$C$52" Then
If Application.WorksheetFunction.CountIf(ws.Range("NameList"),
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("NameList").Sort Key1:=ws.Range("A1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$C$54" Then
If Application.WorksheetFunction.CountIf(ws.Range("NameList"),
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("NameList").Sort Key1:=ws.Range("A1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If



Set ws = Worksheets("Lists")
If Target.Address = "$I$5" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If


Set ws = Worksheets("Lists")
If Target.Address = "$I$6" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$7" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$8" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$9" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$10" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$11" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$12" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$13" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$14" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$15" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$16" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$17" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$18" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$19" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$20" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$21" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$22" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$23" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$24" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$25" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$26" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If


Set ws = Worksheets("Lists")
If Target.Address = "$I$27" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$28" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$29" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$30" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$31" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$32" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$33" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$34" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$35" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$36" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$37" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$38" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$39" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$40" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If





Set ws = Worksheets("Lists")
If Target.Address = "$G$5" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$6" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$7" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$8" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$9" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$10" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$11" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$12" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$13" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$14" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$15" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$16" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$17" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$18" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$19" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$20" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$21" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$22" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$23" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$24" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$25" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$26" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$27" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$28" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$29" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$30" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$31" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$32" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$33" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$34" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$35" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$36" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$37" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$38" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$39" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$40" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

End Sub
 
Hello Dave,

Thanks for your reply. I have posted the complete macro below.

I know there has got to be a better way than what I have done.

I am using Excel 2000. On sheet 1 cell G5-G40 and sheet 1 cell I5-I40 the
user will either select names from the current list (made named lists and
data validtion) or type in a new name. These names that are typed in will be
sorted alphabetically.

The problem that I was having is that the user could only enter in a new
name in cell G5 or cell I5. They could select existing names from the list
from cell g5-g40 and I5-I40 but if they were on cell G15 they couldn't add a
new name to the list.

Therefore I had to make this extremely long macro. Now it works but this
file has now grown to about 146K. Way to big.

I am just learning VBA, but I would think there has to be a way that I could
program it so that it will combine G5-G40 and then I5-I40 without having to
have so many lines of code.

Of course I may be way off. Like I said I am about as green as they come,
but I am slowly learning and understanding, and I admire and respect all of
you guys that so selfishly help all of us novices. Thank you for that.

Sincerely,
John Kitchens

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.Address = "$C$52" Then
If Application.WorksheetFunction.CountIf(ws.Range("NameList"),
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("NameList").Sort Key1:=ws.Range("A1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$C$54" Then
If Application.WorksheetFunction.CountIf(ws.Range("NameList"),
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("NameList").Sort Key1:=ws.Range("A1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If



Set ws = Worksheets("Lists")
If Target.Address = "$I$5" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If


Set ws = Worksheets("Lists")
If Target.Address = "$I$6" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$7" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$8" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$9" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$10" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$11" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$12" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$13" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$14" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$15" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$16" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$17" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$18" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$19" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$20" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$21" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$22" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$23" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$24" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$25" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$26" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If


Set ws = Worksheets("Lists")
If Target.Address = "$I$27" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$28" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$29" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$30" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$31" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$32" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$33" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$34" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$35" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$36" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$37" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$38" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$39" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$I$40" Then
If Application.WorksheetFunction.CountIf(ws.Range("VendorList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("D" & i).Value = Target.Value
ws.Range("VendorList").Sort Key1:=ws.Range("D1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If





Set ws = Worksheets("Lists")
If Target.Address = "$G$5" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$6" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$7" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$8" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$9" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$10" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$11" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$12" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$13" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$14" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$15" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$16" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$17" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$18" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$19" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$20" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$21" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$22" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$23" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$24" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$25" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$26" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$27" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$28" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$29" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$30" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$31" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$32" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$33" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$34" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$35" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$36" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$37" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$38" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$39" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

Set ws = Worksheets("Lists")
If Target.Address = "$G$40" Then
If Application.WorksheetFunction.CountIf(ws.Range("ProductList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("F" & i).Value = Target.Value
ws.Range("ProductList").Sort Key1:=ws.Range("F1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If

End Sub
 
I think that this does what you want.

But first some setup. I didn't see you resizing any of your ranges in code. So
I'm guessing that you're using dynamic range names that expand when you add more
items.

I created a lists worksheet and put headers in row 1 (to be able to update it
manually!).

My validation lists started in row 2 and finished whereever they finished. But
there was no data under the lists.

I used this kind of formula to define the ranges:

=OFFSET(Lists!$A$2,0,0,COUNTA(Lists!$A:$A)-1,1)

(Start in A2 and count how many non-blank cells there are in column A.
(subtracting one for the header).

Same thing for the other ranges (productList and vendorlist).

If you need a reminder about dynamic range names, visit Debra Dalgleish's site:
http://www.contextures.com/xlNames01.html#Dynamic

Then I used this code:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim ws As Worksheet
Dim NameListRng As Range
Dim ProductListRng As Range
Dim VendorListRng As Range
Dim CorrectListRng As Range 'can be any of the 3 above

Dim InputNameRng As Range
Dim InputProductRng As Range
Dim InputVendorRng As Range

With Me 'worksheet with this code.
Set InputNameRng = .Range("c52,c54")
Set InputProductRng = .Range("i5:i40")
Set InputVendorRng = .Range("g5:g40")
End With

If Target.Cells.Count > 1 Then Exit Sub

If Intersect(Target, Union(InputNameRng, InputProductRng, _
InputVendorRng)) Is Nothing Then
Exit Sub
End If

If Trim(Target.Value) = "" Then Exit Sub

'never varies--so set it just once.
Set ws = Worksheets("Lists")
With ws
Set NameListRng = .Range("namelist")
Set ProductListRng = .Range("productlist")
Set VendorListRng = .Range("vendorlist")
End With

'decide which to use
Set CorrectListRng = Nothing
If Not Intersect(Target, InputNameRng) Is Nothing Then
Set CorrectListRng = NameListRng
ElseIf Not Intersect(Target, InputProductRng) Is Nothing Then
Set CorrectListRng = ProductListRng
ElseIf Not Intersect(Target, InputVendorRng) Is Nothing Then
Set CorrectListRng = VendorListRng
Else
'do nothing 'shouldn't happen!
End If


If CorrectListRng Is Nothing Then
'this shouldn't happen!
MsgBox "Design error, contact: JK at xxxx."
Exit Sub
End If

If Application.CountIf(CorrectListRng, Target.Value) > 0 Then
'do nothing, already in that list
Else
With CorrectListRng
.Cells(1).Offset(.Rows.Count, 0).Value = Target.Value
Set CorrectListRng = .Resize(.Rows.Count + 1, 1)
End With
With CorrectListRng
.Sort key1:=.Columns(1), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
End With
End If

End Sub



John said:
Hello Dave,

Thanks for your reply. I have posted the complete macro below.

I know there has got to be a better way than what I have done.

I am using Excel 2000. On sheet 1 cell G5-G40 and sheet 1 cell I5-I40 the
user will either select names from the current list (made named lists and
data validtion) or type in a new name. These names that are typed in will be
sorted alphabetically.

The problem that I was having is that the user could only enter in a new
name in cell G5 or cell I5. They could select existing names from the list
from cell g5-g40 and I5-I40 but if they were on cell G15 they couldn't add a
new name to the list.

Therefore I had to make this extremely long macro. Now it works but this
file has now grown to about 146K. Way to big.

I am just learning VBA, but I would think there has to be a way that I could
program it so that it will combine G5-G40 and then I5-I40 without having to
have so many lines of code.

Of course I may be way off. Like I said I am about as green as they come,
but I am slowly learning and understanding, and I admire and respect all of
you guys that so selfishly help all of us novices. Thank you for that.

Sincerely,
John Kitchens
Click to expand...
<<snipped>>
 
Back
Top