Solving variable variable's names issue in excel - excel

Question

I have a programming issue concerning variable variable's names
I need to make an questionaire in excel where answers to certain questions will either hide or unhide certain rows. I have no idea how to optimize it, although I searched for the solution for quite a while.
Code sample which performs an action on one question
Private Function RowNo(ByVal text1 As String) As Long
Dim f As Range
Set f = Columns(2).Find(text1, Lookat:=xlWhole)
If Not f Is Nothing Then
RowNo = f.Row
Else
RowNo = 0
End If
End Function
Dim QAr As Variant
Dim YtQ1Ar As Variant
Dim YtQ1, rYtQ1 As Long
QAr = Array("Q1")
YtQ1Ar = Array("1.2", "1.3", "1.4", "1.5", "1.6", "1.7", "1.7.1", "1.7.2", "1.7.23", "1.7.24", "1.8", "1.9", "1.10", "1.11", "1.12", "1.13")
For Q = LBound(QAr) To UBound(QAr)
For YtQ1 = LBound(YtQ1Ar) To UBound(YtQ1Ar)
rYtQ1 = RowNo(YtQ1Ar(YtQ1))
If rYtQ1 > 0 Then
Rows(rYtQ1).Hidden = (UCase(Cells(RowNo("1."), ColAn).Value) <> "TAK")
Else
Debug.Print "'" & YtQ1Ar(YtQ1) & "' was not found!"
End If
Next YtQ1
Next Q
Now, I want to perform similar actions on many different questions.
At first I wanted to create a similar arrays and variables with names
Q1, YtQ1Ar;
Q2, YtQ2Ar
... and so on, but I found out that it is impossible to use a variable variable's names in a loop in VBA.
Can you please help me with an idea how to solve that issue? Or do I have to rewrite the code for each question?

Answer 1

There are several ways of creating 'lists' of variables. Three of the most common are:
Collections, exactly as MacroMan's code - take note of how he declares his variables (use a datatype for each declaration).
Multi-dimensional arrays, you can reference each of the indexes independently. This probably wouldn't suit you as the number of sub-questions might vary for each question but, nevertheless, a snippet of your code might be:
Dim questions(10, 20) As Variant 'where first dimension is question number and second is sub-question item.
questions(0,0)="1.1"
questions(0,1)="1.2"
' etc.
Array of Arrays, you can keep a one-dimensional array for each of your sub-question arrays. This might be more suitable to you, like so:
Dim questions(10) As Variant
questions(0) = Array("1.2", "1.3", "1.4", "1.5") 'etc.
questions(1) = Array("2.2", "2.4", "2.6") 'etc.
Having said that, your code is a touch inefficient because it runs the .Find routine in every iteration of your loop and it will throw an unhandled error if any of the sub-question items don't exist in line: Rows(rYtQ).Hidden = (UCase(Cells(RowNo("1."), ColAn).Value) <> "TAK").
Architecturally, you'd be far better to read all of the relevant rows into some kind of storage (say a Range or Collection) in one routine, and in a second routine, check each question to see if those rows need to be hidden. This will give you greater speed and much more flexibility (e.g. to toggle the hidden/unhidden whenever an answer is changed). Sorry it's such a lengthy answer, but it gives you an idea of how important a planned programme structure is.
In the code below, I've given you an example of this. I've used a Class object to make it more obvious (this might be a bit black belt VBA so you may want to ignore it, but it does make the point clearly). So...
First insert a Class Module (Insert ~> Class Module) and name it cQuestionFields. Then paste this code into it:
Option Explicit
Private mQuestionNumber As Integer
Private mAnswerCell As Range
Private mQuestionRange As Range
Private mUnHiddenKey As String
Private mHideUnhideRows As Range
Public Property Get QuestionNumber() As Integer
QuestionNumber = mQuestionNumber
End Property
Public Function AnswerIsChanged(cell As Range) As Boolean
AnswerIsChanged = Not Intersect(cell, mAnswerCell) Is Nothing
End Function
Public Sub HideOrUnhideRows()
Dim answer As String
answer = UCase(CStr(mAnswerCell.Value2))
mHideUnhideRows.EntireRow.Hidden = (answer <> mUnHiddenKey)
End Sub
Public Function InitialiseQuestion(questionNum As Integer, _
questionColumn As Range, _
answerColumn As Range, _
unhideKey As String) As Boolean
Dim ws As Worksheet
Dim thisQ As String
Dim nextQ As String
Dim startCell As Range
Dim endCell As Range
Dim offsetQtoA As Integer
'Assign the question number
mQuestionNumber = questionNum
'Assign column offset between question and answer
offsetQtoA = answerColumn.Cells(1).Column - _
questionColumn.Cells(1).Column
'Convert question number to string format "n."
thisQ = CStr(questionNum) & "."
nextQ = CStr(questionNum + 1) & "."
'Find cell of this question
Set ws = questionColumn.Worksheet
Set startCell = questionColumn.Cells.Find( _
What:=thisQ, _
After:=questionColumn.Cells(1), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
'Check the question exists
If startCell Is Nothing Then
InitialiseQuestion = False
Exit Function
End If
'Set the answer cell
Set mAnswerCell = startCell.Offset(, offsetQtoA)
'Find the last cell within this question range
Set endCell = questionColumn.Cells.Find( _
What:=nextQ, _
After:=startCell, _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
'If nothing is found, set end of column
If endCell Is Nothing Then
Set endCell = ws.Cells(ws.Rows.Count, questionColumn.Column).End(xlUp)
Else
Set endCell = endCell.Offset(-1)
End If
'Define the search range for this question
Set mQuestionRange = ws.Range(startCell, endCell)
'Assign the hiding key
mUnHiddenKey = unhideKey
InitialiseQuestion = True
End Function
Public Sub AssignTargetRows(ParamArray questions() As Variant)
Dim questionItem As Variant
Dim lastCell As Range
Dim foundCell As Range
'Find the relevant cells for each question item
Set lastCell = mQuestionRange.Cells(1)
For Each questionItem In questions
Set foundCell = mQuestionRange.Cells.Find( _
What:=CStr(questionItem), _
After:=lastCell, _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
'If the question item exists, add it to our range
If Not foundCell Is Nothing Then
If mHideUnhideRows Is Nothing Then
Set mHideUnhideRows = foundCell
Else
Set mHideUnhideRows = Union(mHideUnhideRows, foundCell)
End If
Set lastCell = foundCell
End If
Next
End Sub
Now in your module, paste the calling codes:
Option Explicit
Private mQuestionBank As Collection
Public Sub Main()
Dim q As cQuestionFields
'Assign all your values for each question
PopulateQuestionBank
'Loop through each question to test for hiding
For Each q In mQuestionBank
q.HideOrUnhideRows
Next
End Sub
Public Sub ActIfAnswerChanged(Target As Range)
Dim cell As Range
Dim q As cQuestionFields
' Loop through cells in target to see if they are answer cells
For Each cell In Target.Cells
For Each q In mQuestionBank
If q.AnswerIsChanged(cell) Then q.HideOrUnhideRows
Next
Next
End Sub
Public Sub PopulateQuestionBank()
Dim ws As Worksheet
Dim q As cQuestionFields
Dim validQ As Boolean
Set mQuestionBank = New Collection
'Assign the worksheet holding the question.
'You can change this whenever any of your question are on a different sheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
'Question 1: note change question and answer columns to yours.
Set q = New cQuestionFields
validQ = q.InitialiseQuestion(questionNum:=1, _
questionColumn:=ws.Columns(2), _
answerColumn:=ws.Columns(4), _
unhideKey:="TAK")
If validQ Then
q.AssignTargetRows "1.2", "1.3", "1.4", "1.5", "1.6", "1.7", "1.7.1", "1.7.2", "1.7.23", "1.7.24", "1.8", "1.9", "1.10", "1.11", "1.12", "1.13"
mQuestionBank.Add q, Key:=CStr(q.QuestionNumber)
End If
'Question 2
Set q = New cQuestionFields
validQ = q.InitialiseQuestion(questionNum:=2, _
questionColumn:=ws.Columns(2), _
answerColumn:=ws.Columns(4), _
unhideKey:="TAK")
If validQ Then
q.AssignTargetRows "2.2", "2.3", "2.4", "2.5", "2.6"
mQuestionBank.Add q, Key:=CStr(q.QuestionNumber)
End If
'Question 3
Set q = New cQuestionFields
validQ = q.InitialiseQuestion(questionNum:=3, _
questionColumn:=ws.Columns(2), _
answerColumn:=ws.Columns(4), _
unhideKey:="TAK")
If validQ Then
q.AssignTargetRows "3.7", "3.7.3", "3.7.2", "3.7.23", "3.7.24"
mQuestionBank.Add q, Key:=CStr(q.QuestionNumber)
End If
End Sub
You'll see that I've added a routine called ActIfAnswerChanged. This is what I mean by added flexibility. If you post the following code in your Worksheet_Change event (double click your question sheet in your VBA editor and select this event), then it will run hide/unhide the rows whenever an answer is changed.
Private Sub Worksheet_Change(ByVal Target As Range)
ActIfAnswerChanged Target
End Sub

Answer 2

Try something like:
Dim QColl As Collection
Dim Q As Long
Dim YtQAr As Variant
Dim YtQ As Long, rYtQ As Long
Set QColl = New Collection
QColl.Add Array("1.2", "1.3", "1.4", "1.5"), Key:="Q1"
QColl.Add Array("2.2", "2.3"), Key:="Q2"
For Q = 1 To QColl.Count
YtQAr = QColl.Item("Q" & Q)
For YtQ = LBound(YtQAr) To UBound(YtQAr)
rYtQ = RowNo(YtQAr(YtQ))
If rYtQ > 0 Then
Rows(rYtQ).Hidden = (UCase(Cells(RowNo("1."), ColAn).Value) <> "TAK")
Else
Debug.Print "'" & YtQAr(YtQ) & "' was not found!"
End If
Next YtQ
Next Q