Generating Possible Combinations and Assigning ID Number

[Joe Kluck]

I'm not even sure if this is possible, but if anyone has advice I would
greatly appreciate it.

I'm transcribing information from my study into an Excel Spreadsheet. In my
study, "mental health disorder" is part of my baseline demographics. When
entering the data into the spreadsheet, I would like to assign a number to
each "mental health disorder". However, many patients have various
combinations of these disorders, and I would like to assign one number for
each possible combination, to simplify the data entering process.

From the information I have collected, I was able to categorize the
disorders into 9 categories. Would it be possible to have Excel generate a
list of all possible combinations of these disorders, and then assign a
unique number to each combination?

These are the 9 categories I'm working with:
Anxiety Disorder
Bipolar Disorder
Cognitive Disorder
Depressive Disorder
Mood Disorder
Panic Disorder
Personality Disorder
PTSD
Schizophrenia

Even if this is possible, I'm not sure if it's the most efficient process.
I know I won't have a ridiculous amount of combinations, but having Excel
create the list would save me from manually determining which combinations
are currently present in my study.

Any feed back would be greatly appreciated. Thanks!

 

[Gary''s Student]

First run the small macro TestThis:

Function ListSubsets(Items As Variant) As String
Dim CodeVector() As Integer
Dim i As Integer
Dim lower As Integer, upper As Integer
Dim SubList As String
Dim NewSub As String
Dim done As Boolean
Dim OddStep As Boolean
SubList = ""
OddStep = True
lower = LBound(Items)
upper = UBound(Items)
Dim kk As Long
kk = 1
ReDim CodeVector(lower To upper) 'it starts all 0
Do Until done
'Add a new subset according to current contents
'of CodeVector

NewSub = ""
For i = lower To upper
If CodeVector(i) = 1 Then
If NewSub = "" Then
NewSub = Items(i)
Else
NewSub = NewSub & ", " & Items(i)
End If
End If
Next i
If NewSub = "" Then NewSub = "{}" 'empty set
Cells(kk, "B").Value = NewSub
kk = kk + 1
'now update code vector
If OddStep Then
'just flip first bit
CodeVector(lower) = 1 - CodeVector(lower)
Else
'first locate first 1
i = lower
Do While CodeVector(i) <> 1
i = i + 1
Loop
'done if i = upper:
If i = upper Then
done = True
Else
'if not done then flip the *next* bit:
i = i + 1
CodeVector(i) = 1 - CodeVector(i)
End If
End If
OddStep = Not OddStep 'toggles between even and odd steps
Loop
ListSubsets = SubList
End Function

Sub TestThis()
Dim B(1 To 9) As Variant
Dim f As String
B(1) = "Anxiety Disorder"
B(2) = "Bipolar Disorder"
B(3) = "Cognitive Disorder"
B(4) = "Depressive Disorder"
B(5) = "Mood Disorder"
B(6) = "Panic Disorder"
B(7) = "Personality Disorder"
B(8) = "PTSD"
B(9) = "Schizophrenia"

f = ListSubsets(B)

End Sub


Then in A2 thru A512 enter: =row()

This should display all 512 combinations. the first four records look like:

{}
2 Anxiety Disorder
3 Anxiety Disorder, Bipolar Disorder
4 Bipolar Disorder
5 Bipolar Disorder, Cognitive Disorder
etc.

This is an adaptaion of code posted by John Coleman:

http://www.microsoft.com/communitie...&p=1&tid=1fd10426-1802-47e1-b372-b6a19c6fc282