I want to create check boxes attached to a list cell. In the list, it
contains ten names, when I choose a different name, I want to be able to list
25 attributes of each name into 25 check boxes and save the individual
responses for each of the names. So that if I choose Paul, I will get 25
attributes specific to Paul and if I choose Steve, the same
Please see if this test implementation is what you want
I have made only 5 attributes instead of your 25 but if this
Implementation works you can easily set up 25
The implementation is in 2 parts
First set up the worksheet
Second add the VBA code
Set up the worksheet
So as to not have any conflicts with existing code and /or data
I suggest you open a new workbook
On Sheet1 of this new workbook select row 3 and then
Select the menu Format Row Height and set to 30
Select columns H to L and widen to 12
In cells H3 to L3 create a forms toolbar checkbox
In each cell
Start with cell H3
Size each checkbox so that is slightly smaller than the cell
It is important that each checkbox is named Check Box 1
Checkbox 2 etc
Excel should name them automatically like this anyway
If you do them in the correct order i.e. H3, I3, J3, K3, L3
But just double check
After you have created the 5 checkboxes edit the text inside
them as follows
First checkbox should have the text Married,
next ProfitShare
next Over30
next Male
last Creditcard
Then link each checkbox with a cell as follows
Checkbox in cell H3 link to C1
I3 to D1
J3 to E1 etc
Select the cells C1 to G1 give them a range name Attributes
In B5 to B14 enter the 10 names you want
Select the 10 names and range name them ListN
In cells C4 to G4 enter the same text as in the checkboxes
I.e. Married, Profitshare ETC
I.e. in c4 Married in D4 Profitshare etc
Select cells C5 to G14 and type TRUE hold the control key down as you
press enter
Hide columns C to G
Add the VB code
Right click the Sheet1 tab and select View code
Copy the following procedure into the module
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Dim NoOfAttributes As Integer
NoOfAttributes = Range("Attributes").Columns.Count
Set rng = Range("ListN")
If Target.Cells.Count > 1 Then
Exit Sub
End If
If Not Application.Intersect(Target, rng) Is Nothing Then
Range("Attributes").Value = Target.Offset(0, 1).Resize(1,
NoOfAttributes).Value
Set Module1.ClickedCell = Target
Else
Set Module1.ClickedCell = Nothing
End If
End Sub
From the VB menu select Insert Module and copy the following procedure
into the module
Public ClickedCell As Range
Sub UpdateData()
Dim CBIndex As Long
CBIndex = Right(ActiveSheet.CheckBoxes(Application.Caller).Name, 1)
If ClickedCell Is Nothing Then
Exit Sub
End If
If ActiveSheet.CheckBoxes(Application.Caller).Value = 1 Then
ClickedCell.Offset(0, CBIndex).Value = True
Else
ClickedCell.Offset(0, CBIndex).Value = False
End If
End Sub
Press ALT F11 to return to excel
Save the workbook
Click a name in the list and change the checkboxes as you move from
name to name the choices are saved
Please tell me if it works for you
