Using advanced custom list in Excel

[njb1906]

I have a small problem. I would like to create an excel solution that
will enable users to classify a set of items up a product hierarchy.
Let's say that one of the levels of this hierarchy is Category. I have
a set of predefined categories that I want the users to select from. I
have created these predefined categories as a custom list in Excel.

As I mentioned, my goal is to allow the users to classify a set of
items by category. I would like to create a combo box off of my custom
list so that as the users go through and start assigning the items to a
category, they will have a list of categories to choose from, with the
option of typing up their own category, in case the category that they
want does not already exist.

any help with this issue would be extremely appreciated.

Thanks.

 

[Debra Dalgleish]

Create a Category List
--Type your list of categories
--Select the cells in the list
--Click in the Name box, to the left of the formula bar
--Type a one-word name for the list, e.g. Categories.
--Press the Enter key.

Apply Data Validation
--Select the cells in which the user will select or type a category.
--Choose Data>Validation
--From the Allow dropdown, choose List
--In the Source box, type: =Categories
--On the Error Alert tab, remove the check mark from 'Show error alert
after invalid data is entered
--Click OK

Add code to append new categories
--Right-click the sheet tab on the sheet with data validation
--Choose View Code, and paste in the following code
(In this example, the Categories list is on Sheet1, and the
Data Validation is on Sheet2, Column A)

Users can select or type a category. New categories will be
automatically added to the categories list.

'=============================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws1 As Worksheet
Dim rng As Range
Set ws1 = Worksheets("Sheet1")
Set rng = ws1.Range("Categories")
If Target.Count > 1 Then Exit Sub
If Target.Column = 1 And Target.Row > 1 Then
If Application.WorksheetFunction _
.CountIf(rng, Target.Value) Then
'do nothing
Else
rng.Offset(rng.Cells.Count, 0) _
.Resize(1, 1).Value = Target.Value
rng.CurrentRegion.Name = "Categories"
Set rng = ws1.Range("Categories")
rng.Sort Key1:=ws1.Range("A1"), _
Order1:=xlAscending, Header:=xlNo
End If
End If
End Sub
'=================================