Hi,

The following uses MsgBoxes with Yes, No and Cancel buttons to ask
questions such that the ensuing question depends on the user's answer
to the previous question.
At the moment it is set up for 6 levels of questions...

Level 1 Q1
Level 2 Q2 if A1=Yes or Q3 if A1=No
Level 3 Q4 if A2=Yes or Q5 if A2=No or Q6 if A3=Yes or Q7 if A3=No
Level 4 Q8 if A4=Yes or Q9 if A4=No or Q10 if A5=Yes or Q11 if A5=No or
Q12 if A6=Yes or Q13 if A6=No or Q14 if A7=Yes or Q15 if A7=No
Level 5 Blah Blah Blah The number of questions increases exponentially
and it's better illustrated using a tree diagram.

The code is easily readjusted to suit any number of levels, you would
only have to change the upper bounds of the two arrays for the
questions and answers and change the Do Loop's exit value (6 at the
moment).

Of course you have to edit the code so that the appropriate questions
are presented to the user.

The number of questions needed depends on the number of levels...

1 Level..... 1 question
2 Levels... 3 question
3 Levels... 7 questions
N Levels... (2^N) -1 questions

As it stands the code finishes off with a for next loop to show all the
presented questions and the user's answers. However, if you are wanting
to have the code determine "which papers need to be filled out for a
specific account" you could base that decision on the value of the
string variable strAnswerHistory eg if it equals "001110" then the
user's responses were no, no, yes, yes, yes, no so that it is up to
you, the developer, to set up the rest of the code so that it produces
the appropriate solution.

You want the questions asked when the program is opened. If by that you
mean when the workbook is opened then paste the Private Sub
Workbook_Open() sub into the ThisWorkbook code module.
If you want the questions asked after the user clicks a button or
whatever then paste the body of the code into a standard module after
inserting a procedure.

The Function that the main sub uses has to be pasted into the standard
module too....

Private Sub Workbook_Open()
Dim I As Integer
Dim strQuestion(1 To 63)
Dim strAnswer(1 To 63)
Dim strAnswerHistory As String
Dim iQuestionHistory() As Integer
Dim Level As Byte
Dim Next_Question As Integer
strQuestion(1) = "Q1?"
strQuestion(2) = "Q2?"
strQuestion(3) = "Q3?"
strQuestion(4) = "Q4?"
strQuestion(5) = "Q5?"
strQuestion(6) = "Q6?"
strQuestion(7) = "Q7?"
strQuestion(8) = "Q8?"
strQuestion(9) = "Q9?"
strQuestion(10) = "Q10?"
strQuestion(11) = "Q11?"
strQuestion(12) = "Q12?"
strQuestion(13) = "Q13?"
strQuestion(14) = "Q14?"
strQuestion(15) = "Q15?"
strQuestion(16) = "Q16?"
strQuestion(17) = "Q17?"
strQuestion(18) = "Q18?"
strQuestion(19) = "Q19?"
strQuestion(20) = "Q20?"
strQuestion(21) = "Q21?"
strQuestion(22) = "Q22?"
strQuestion(23) = "Q23?"
strQuestion(24) = "Q24?"
strQuestion(25) = "Q25?"
strQuestion(26) = "Q26?"
strQuestion(27) = "Q27?"
strQuestion(28) = "Q28?"
strQuestion(29) = "Q29?"
strQuestion(30) = "Q30"
strQuestion(31) = "Q31?"
strQuestion(32) = "Q32?"
strQuestion(33) = "Q33?"
strQuestion(34) = "Q34?"
strQuestion(35) = "Q35?"
strQuestion(36) = "Q36?"
strQuestion(37) = "Q37?"
strQuestion(38) = "Q38?"
strQuestion(39) = "Q39?"
strQuestion(40) = "Q40?"
strQuestion(41) = "Q41?"
strQuestion(42) = "Q42?"
strQuestion(43) = "Q43?"
strQuestion(44) = "Q44?"
strQuestion(45) = "Q45?"
strQuestion(46) = "Q46?"
strQuestion(47) = "Q47?"
strQuestion(48) = "Q48?"
strQuestion(49) = "Q49?"
strQuestion(50) = "Q50?"
strQuestion(51) = "Q51?"
strQuestion(52) = "Q52?"
strQuestion(53) = "Q53?"
strQuestion(54) = "Q54?"
strQuestion(55) = "Q55?"
strQuestion(56) = "Q56?"
strQuestion(57) = "Q57?"
strQuestion(58) = "Q58?"
strQuestion(59) = "Q59?"
strQuestion(60) = "Q60?"
strQuestion(61) = "Q61?"
strQuestion(62) = "Q62?"
strQuestion(63) = "Q63?"
Do While Level < 6
Level = Level + 1
If Level = 1 Then Next_Question = 1
ReDim Preserve iQuestionHistory(Level)
iQuestionHistory(Level) = Next_Question
strAnswer(Next_Question) = _
MsgBox(strQuestion(Next_Question), 3)
Select Case strAnswer(Next_Question)
Case 6
strAnswerHistory = strAnswerHistory & "1"
Case 7
strAnswerHistory = strAnswerHistory & "0"
Case 2
Exit Sub
End Select
Next_Question = _
next_question_number(strAnswerHistory)
Loop
For I = 1 To Level
MsgBox strQuestion(iQuestionHistory(I)) & "..." _
& IIf(Mid(strAnswerHistory, I, 1) = "1", "Yes", "No")
Next
End Sub

Public Function next_question_number _
(strInput As String) As Integer
Dim iDigits As Integer
iDigits = Len(strInput)
Dim iBinaryToInteger As Integer
Dim I As Integer
For I = 1 To iDigits
Select Case Mid(strInput, I, 1)
Case "1"
Case "0"
iBinaryToInteger = iBinaryToInteger _
+ 2 ^ (iDigits - I)
End Select
next_question_number = 2 ^ iDigits _
+ iBinaryToInteger
Next
End Function

Ken Johnson