List Box Size

Before adding the target value to the word list, you could check for an
empty string in the target cell, e.g.:

If Target.Value = "" Then Exit Sub


Orf Bartrop wrote:
Thanks Debra, your code works well. However, I now find that if an
incorrect entry is typed into the drop down list box (column "C") and
then deleted, it deletes the second record in the CustomList on the
Lists sheet.

The worksheet code is:



Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ws_exit:
Application.EnableEvents = False
With Target
If .Column = 4 Or .Column = 5 Or .Column = 6 Then
If .Row 3 Then
With Cells(.Row, "A")
.Value = Format(Date, "dd mmm yyyy")
End With
End If
End If
End With

ws_exit:
Application.EnableEvents = True

' Transfer word to list

On Error Resume Next
Dim ws As Worksheet
Dim i As Integer


Set ws = Worksheets("Lists")
If Target.Column = 3 And Target.Row 5 Then
On Error GoTo wt_exit:
ws.Unprotect
If Application.WorksheetFunction.CountIf(ws.Range("Cu stomList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("B" & i).Value = Target.Value
ws.Range("B1:B" & i).Name = "CustomList"
ws.Range("CustomList").Sort Key1:=ws.Range("B1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If
ws.Protect
wt_exit:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column = 3 Then
ActiveSheet.Unprotect
Else
ActiveSheet.Protect
End If

End Sub


The code on the Lists sheet is:



Private Sub Worksheet_Change(ByVal Target As Range)

Columns(2).Sort Key1:=Range("B1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom

End Sub



Can you see where the problem is?

My aim is to allow either selection from the list or to make a new entry
that will be added to the list. Mistakes are bound to be made by the
user so I have to guard against this.

Orf



--
Debra Dalgleish
Excel FAQ, Tips & Book List
http://www.contextures.com/tiptech.html

Thank you Debra, you solved my problem and now all is working but not
before I found that in my bumbling attempt to create my masterpiece I
must have corrupted not only my file but Excel itself. No wonder I have
had difficulties over the last week or so getting scripts to run.

I found my drop down list was only displaying 2 items instead of 8 and
the list would not sort correctly. I ended up doing a repair on Excel
and deleted the drop down box and recreated it. Then the system started
to work as designed.

My first, and probably my last, foray into Excel was enlightening but
not all pleasure but thanks to you, Bob Phillips and this wonderfully
helpful newsgroup I achieved my goal.

Orf

Debra Dalgleish wrote:

Before adding the target value to the word list, you could check for
an empty string in the target cell, e.g.:

If Target.Value = "" Then Exit Sub


Orf Bartrop wrote:

Thanks Debra, your code works well. However, I now find that if an
incorrect entry is typed into the drop down list box (column "C") and
then deleted, it deletes the second record in the CustomList on the
Lists sheet.

The worksheet code is:



Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ws_exit:
Application.EnableEvents = False
With Target
If .Column = 4 Or .Column = 5 Or .Column = 6 Then
If .Row 3 Then
With Cells(.Row, "A")
.Value = Format(Date, "dd mmm yyyy")
End With
End If
End If
End With

ws_exit:
Application.EnableEvents = True

' Transfer word to list

On Error Resume Next
Dim ws As Worksheet
Dim i As Integer


Set ws = Worksheets("Lists")
If Target.Column = 3 And Target.Row 5 Then
On Error GoTo wt_exit:
ws.Unprotect
If Application.WorksheetFunction.CountIf(ws.Range("Cu stomList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("B" & i).Value = Target.Value
ws.Range("B1:B" & i).Name = "CustomList"
ws.Range("CustomList").Sort Key1:=ws.Range("B1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If
ws.Protect
wt_exit:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column = 3 Then
ActiveSheet.Unprotect
Else
ActiveSheet.Protect
End If

End Sub


The code on the Lists sheet is:



Private Sub Worksheet_Change(ByVal Target As Range)

Columns(2).Sort Key1:=Range("B1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom

End Sub



Can you see where the problem is?

My aim is to allow either selection from the list or to make a new
entry that will be added to the list. Mistakes are bound to be made
by the user so I have to guard against this.

Orf

You're welcome, and thanks for letting me know that you've finally got
it working. If you venture into Excel territory again, I hope it gives
you less trouble!

Orf Bartrop wrote:
Thank you Debra, you solved my problem and now all is working but not
before I found that in my bumbling attempt to create my masterpiece I
must have corrupted not only my file but Excel itself. No wonder I have
had difficulties over the last week or so getting scripts to run.

I found my drop down list was only displaying 2 items instead of 8 and
the list would not sort correctly. I ended up doing a repair on Excel
and deleted the drop down box and recreated it. Then the system started
to work as designed.

My first, and probably my last, foray into Excel was enlightening but
not all pleasure but thanks to you, Bob Phillips and this wonderfully
helpful newsgroup I achieved my goal.

Orf

Debra Dalgleish wrote:

Before adding the target value to the word list, you could check for
an empty string in the target cell, e.g.:

If Target.Value = "" Then Exit Sub


Orf Bartrop wrote:

Thanks Debra, your code works well. However, I now find that if an
incorrect entry is typed into the drop down list box (column "C") and
then deleted, it deletes the second record in the CustomList on the
Lists sheet.

The worksheet code is:



Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ws_exit:
Application.EnableEvents = False
With Target
If .Column = 4 Or .Column = 5 Or .Column = 6 Then
If .Row 3 Then
With Cells(.Row, "A")
.Value = Format(Date, "dd mmm yyyy")
End With
End If
End If
End With

ws_exit:
Application.EnableEvents = True

' Transfer word to list

On Error Resume Next
Dim ws As Worksheet
Dim i As Integer


Set ws = Worksheets("Lists")
If Target.Column = 3 And Target.Row 5 Then
On Error GoTo wt_exit:
ws.Unprotect
If Application.WorksheetFunction.CountIf(ws.Range("Cu stomList"),
Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("B" & i).Value = Target.Value
ws.Range("B1:B" & i).Name = "CustomList"
ws.Range("CustomList").Sort Key1:=ws.Range("B1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If
ws.Protect
wt_exit:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column = 3 Then
ActiveSheet.Unprotect
Else
ActiveSheet.Protect
End If

End Sub


The code on the Lists sheet is:



Private Sub Worksheet_Change(ByVal Target As Range)

Columns(2).Sort Key1:=Range("B1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom

End Sub



Can you see where the problem is?

My aim is to allow either selection from the list or to make a new
entry that will be added to the list. Mistakes are bound to be made
by the user so I have to guard against this.

Orf






--
Debra Dalgleish
Excel FAQ, Tips & Book List
http://www.contextures.com/tiptech.html