Here you are, this should do it


Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A:B" '<== change to suit
Const SH_DATA As String = "Sheet2" '<== change to suit
Const VAL_DEPTS As String = "Depts" '<== change to suit
Dim wsData As Worksheet
Dim iRow As Long, iCol As Long

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
Set wsData = Worksheets(SH_DATA)
With Target
If .Column = 2 Then

'check if this value in list of departments
'if not add it and update name
On Error Resume Next
iCol = Application.Match(.Value, wsData.Rows(1), 0)
On Error GoTo ws_exit
If iCol = 0 Then
iCol = wsData.Cells(1,
wsData.Columns.Count).End(xlToLeft).Column
If iCol 1 Or wsData.Cells(1, iCol).Value < "" Then
iCol = iCol + 1
End If
wsData.Cells(1, iCol).Value = .Value
wsData.Range("A1").Resize(, iCol).Name = VAL_DEPTS
End If

Else

'check if this employee associated with this department
'if not add it and update name
On Error Resume Next
iCol = Application.Match(.Offset(0, 1).Value,
wsData.Rows(1), 0)
If iCol < 0 Then
iRow = Application.Match(.Value, wsData.Columns(iCol),
0)
On Error GoTo ws_exit
If iRow = 0 Then
iRow = wsData.Cells(wsData.Rows.Count,
iCol).End(xlUp).Row + 1
wsData.Cells(iRow, iCol).Value = .Value
wsData.Cells(2, iCol).Resize(iRow - 1).Name = _
Replace(wsData.Cells(1, iCol), " ", "_")
End If
Else
On Error GoTo ws_exit
End If

End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click


It chaecks for any changes in column A or B on the target sheet, and updates
lists on Sheet2, maintaining the names as it goes along.

It is all configurable to facilitate easy change in your situation.

Just change the DV to point at these new names.

--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)


"Ixtreme" wrote in message
ps.com...
I know, I will create several named ranges per department consisting of
a number of employees but what I don't want is to manually change the
named range each time an employee is added. For that specific part I
want something in vba.


Bob Phillips wrote:

That is what I was saying in my earlier response, so you need to maintain
separate lists IMO.

--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)


"Ixtreme" wrote in message
oups.com...
Bob,

thanks for your reply. What I mean is that I create name ranges today
for each employee that belongs to eg department AAA. Tomorrow I will
add a new user that also belongs to department AAA. I want something in
the workbook change event or deactivate event that will automatically
update my previous defined range. On the other sheet I use the listbox
to refer to the named range and if everything is OK, I can select the
new collegae as well.


Bob Phillips schreef:

Do you mean that you want defined names for Department AAA, and BBB,
etc.?

If so, I think that you will need to create new independent lists of
each
with the associated employees, name these and use them in the Data
Validation.

--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)


"Ixtreme" wrote in message
ups.com...
I have a sheet with employees and department on it. What I need is a
pice of vba code that does the following:

Update defined name ranges automatically upon adding new employees.

The sheet looks like this

A B C
1 Employee 1 Department AAA
2 Employee 2 Department BBB
3 Employee 3 Department AAA
4 Employee 4 Department CCC
5 Employee 5 Department AAA
6 Employee 6 Department DDD

The code should automatically update the values of the defined named
ranges (created via Insert, Name, Define) based on Department if a
new
employee is added to this list in cell A7.

On another sheet I have a cell with a list box (via Data,
Validation,
allow LIST, where source refers to the (updated) Defined range.

Mark