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" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
>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" <(E-Mail Removed)> wrote in message
>> news:(E-Mail Removed)...
>> > 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" <(E-Mail Removed)> wrote in message
>> >> news:(E-Mail Removed)...
>> >> >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
>> >> >
>> >
>
|
Similar Threads
