hey i need help developing a program that when you open it, you will be asked
a certain yes or no question and based on that answer, you will be asked
another question (yes or no) and so on..., allowing you in the end to be able
to recognize , for example, which papers need to be filled out for a specific
account. (as in loan papers or account papers as to which program or group it
is part of.) any help will be great, thanks.

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

Hi,

I've changed the code to allow for different question-chain lengths so
that the loop is exited after the user answers a chain of questions
that is less than the greatest level in the code and the answers to
those questions is enough for a decision to be made.

The pattern followed by the code is...

If the answer to Question N is Yes then Question 2N is asked.
If the answer to Question N is No then Question 2N + 1 is asked

If a decision can be made after the User answers Question N with a Yes,
then in the code make Question 2N an empty string (strQuestion(2N) =
"").
If a decision can be made after the user answers Question N with a No,
then in the code make Question 2N + 1 an empty string (strQuestion(2N
+ 1) = "")

Now there is no need to change the code to a lower maximum number of
levels.
Changes only need to be made if you need more than 6 levels. To
increase the maximum number of levels change the value of iMaxLevel and
add the additional questions (Total number of questions is
(2^(iMaxLevel) - 1)

Below is the Workbook_Open version. The Function (hasn't changed) can
also be pasted in the ThisWorkbook module.

Private Sub Workbook_Open()
Dim I As Integer
Dim strQuestion()
Dim strAnswer()
Dim strAnswerHistory As String
Dim iQuestionHistory() As Integer
Dim Level As Byte
Dim Next_Question As Integer
Dim iMaxLevel As Byte
iMaxLevel = 6
ReDim strQuestion(1 To (2 ^ iMaxLevel) - 1)
ReDim strAnswer(1 To (2 ^ iMaxLevel) - 1)
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 < iMaxLevel
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)
If Level < iMaxLevel Then
If strQuestion(Next_Question) = "" Then
Exit Do
End If
End If
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