I now have pretty much everything working from the code (shown below) that
Tom Ogilvy posted for the listbox (thanks to all for responding).
I have 2 more questions on this. Firstly, I have not been able to program
ColumnHeads into the listbox (i.e. .ColumnHeads = True). What do I need to do
for this?
Next question - I will have several identical worksheets and would like this
macro to work in each one. Is this possible or do I just need to cut and
paste it into each worksheet.

Thanks in advance for any assistance.
Brad

My code now is:

Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim initialcell
Dim Initialcellr
Dim Intialcellafter
initialcell = ActiveCell.Value
Initialcellr = ActiveCell.Address

If ActiveCell.Value = "" Then
On Error Resume Next
Me.ListBoxes.Delete
On Error GoTo 0

If Target.Column = 3 Then
With Worksheets(1).Shapes.AddFormControl(xlListBox, ActiveCell.Left _
+ ActiveCell.Width + 10, ActiveCell.Top + 10, 200, 80)
.Name = "Listbox1"
' .ControlFormat.ListFillRange = "Sheet2!a1:a7"
'
.ControlFormat.AddItem "Bulk"
.ControlFormat.AddItem "Hospital"

.ControlFormat.AddItem "Line"
.ControlFormat.AddItem "Nasal"
.ControlFormat.AddItem "Misc."
.ControlFormat.AddItem ""

End With
Me.ListBoxes("Listbox1").OnAction = "Box_Click "
End If
End If
End Sub

Hi Brad,

I have 2 more questions on this. Firstly, I have not been able to
program ColumnHeads into the listbox (i.e. .ColumnHeads = True).
What do I need to do

You are using a listbox from the Forms toolbox. This does not support
ColumnHeads.

Next question - I will have several identical worksheets and would like
this
macro to work in each one. Is this possible or do I just need to cut and
paste it into each worksheet.

With minor adaptation you could replace your existing event code with a
Worksheet_SelectionChange event procedure..

The following code, pasted into the the workbook's ThisWorkbook module,
worked for me:

Private Sub Workbook_SheetSelectionChange _
(ByVal Sh As Object, ByVal Target As Range)

Dim arrInclude As Variant
Dim blInclude As Boolean

arrInclude = Array("Sheet1", "Sheet2", _
"Sheet3", "Sheet4") '<<======= CHANGE

On Error Resume Next
blInclude = Application.Match(Sh.Name, arrInclude, 0)
On Error GoTo 0
If Not blInclude Then Exit Sub

If ActiveCell.Value = "" Then
On Error Resume Next
Sh.ListBoxes.Delete
On Error GoTo 0

If Target.Column = 3 Then
With Sh.Shapes.AddFormControl(xlListBox, ActiveCell.Left _
+ ActiveCell.Width + 10, _
ActiveCell.Top + 10, 200, 80)
.Name = "Listbox1"
.ControlFormat.AddItem "Bulk"
.ControlFormat.AddItem "Hospital"
.ControlFormat.AddItem "Line"
.ControlFormat.AddItem "Nasal"
.ControlFormat.AddItem "Misc."
.ControlFormat.AddItem ""
End With
Sh.ListBoxes("Listbox1").OnAction = "Box_Click "
End If
End If
End Sub

Change the worksheet names in the line:

arrInclude = Array("Sheet1", "Sheet2", _
"Sheet3", "Sheet4") '<<======= CHANGE

to include only those where the listbox is to be used.

If the code is intended to operate on all worksheets, then delete (or
comment out) the above line together with the following four lines of code.

As you surmised, you could paste your existing code into each of the
relevant sheet modules. This would, IMO, have a higher maintenance overhead
as any amendments would need to be effected in each sheet. .

Incidentally, I have not included the following lines from your posted code:

Dim initialcell
Dim Initialcellr
Dim Intialcellafter
initialcell = ActiveCell.Value
Initialcellr = ActiveCell.Address

as they do not appear to have any immediate relevance.


---
Regards,
Norman



"Brad K." wrote in message
...
I now have pretty much everything working from the code (shown below) that
Tom Ogilvy posted for the listbox (thanks to all for responding).
I have 2 more questions on this. Firstly, I have not been able to program
ColumnHeads into the listbox (i.e. .ColumnHeads = True). What do I need to
do
for this?
Next question - I will have several identical worksheets and would like
this
macro to work in each one. Is this possible or do I just need to cut and
paste it into each worksheet.

Thanks in advance for any assistance.
Brad

My code now is:

Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim initialcell
Dim Initialcellr
Dim Intialcellafter
initialcell = ActiveCell.Value
Initialcellr = ActiveCell.Address

If ActiveCell.Value = "" Then
On Error Resume Next
Me.ListBoxes.Delete
On Error GoTo 0

If Target.Column = 3 Then
With Worksheets(1).Shapes.AddFormControl(xlListBox, ActiveCell.Left
_
+ ActiveCell.Width + 10, ActiveCell.Top + 10, 200, 80)
.Name = "Listbox1"
' .ControlFormat.ListFillRange = "Sheet2!a1:a7"
'
.ControlFormat.AddItem "Bulk"
.ControlFormat.AddItem "Hospital"

.ControlFormat.AddItem "Line"
.ControlFormat.AddItem "Nasal"
.ControlFormat.AddItem "Misc."
.ControlFormat.AddItem ""

End With
Me.ListBoxes("Listbox1").OnAction = "Box_Click "
End If
End If
End Sub