Proper `If Condition` and Proper Use of` Loop Structure` in Excel-VBA

Question

There are three sheets in my book: Namely; Questions, Answersand Incorrect Mappings.

The Questions Sheet: Column A- Question_Id.

Column B: Answer_Typematters among: True / False , Friend , Multi item , CheckBoxes , Event .

Column C: Answer_Id(One or more "numeric values"), separated by semicolons.

The Answers Sheet:

Column A Answer_Id. (This will list some or all of the answer identifiers of the sheet Questions, each on the same line).

Column B- Frequency; which has meanings such as:

Event , Annually , Six months , Quarterly .

A question and answer sheet is associated with a column Answer_Id.

Requirement: If any question ID has "Answer Types" such as True / False, One another, Multi item, CheckBoxes; then answer it in a Answerssheet should not have a frequency Event Basedagainst such an Answer_Id. those. if Answer_Typeis an “event”, then only the frequency against it should be event-based

Incorrect comparisons in the sheet Questionsshould be sent to the sheet Incorrect Mappingsas hyperlinks to the Questions sheet. I wrote the following code:

Dim shname, strstr, strErr, stString As String
Dim stArray() As String

Dim AnsIds1 As Range
Dim celadr, celval, AnsId1, AnsId2, questionType As Variant

Dim LastRow, LastRowSheet2 As Long
LastRow = Sheets("Questions").Cells(Rows.Count, 2).End(xlUp).Row
LastRowSheet2 = Sheets("Answers").Cells(Rows.Count, 2).End(xlUp).Row


For Each questionType In Worksheets("Questions").Range("B2:B" & LastRow)
    celadr = questionType.Address
    celval = questionType.Value
    If Len(celval) >= 1 Then
        If InStr(1, ("TRUE/FALSE,ONE ANOTHER,MULTI ITEM,CHECKBOXES,"), UCase(celval) & ",") >= 1 Then
        For Each AnsIds1 In Worksheets("Questions").Range("C2:C" & LastRow)
            stString = AnsIds1
            stArray() = Split(stString, ";")
            For Each AnsId1 In stArray()
                For Each AnsId2 In Worksheets("Answers").Range("A2:A" & LastRowSheet2).Cells

                    If Trim(AnsId1) = Trim(AnsId2) Then
                         If Trim(UCase(AnsId2.Offset(0, 1).Value)) = "EVENT BASED" Then  'Is this If condition should be changed to something else?
                         AnsIds1.Interior.Color = vbRed
                            celadr = AnsIds1.Address
                            Sheets("Questions").Select
                            shname = ActiveSheet.Name
                            Sheets("Incorrect Mappings").Range("A65536").End(xlUp).Offset(1, 0).Value = AnsId2 & " Should not have Event based frequency"
                            strstr = "'" & shname & "'!" & Range(celadr).Address(0, 0)
                            Sheets("Incorrect Mappings").Hyperlinks.Add Anchor:=Sheets("Incorrect Mappings").Range("A65536").End(xlUp), Address:="", SubAddress:=strstr
                        End If
                    End If
                Next
            Next
        Next
        End If
    End If
Next

When I run the above code, I get mixed output (wrong output).

, ,    Is this If condition should be changed to something else? .

- , ?

( , , Incorrect Mappings, )

Answer 1

Scripting.Dictionary .

Sub question_Check_by_Dictionary()
    Dim questionType As Range
    Dim v As Long, vAIDs As Variant, d As Long, dict As Object

    'load the dictionary with the answer types
    Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    With Worksheets("Answers")
        For d = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            dict.Item(CStr(.Cells(d, 1).Value2)) = .Cells(d, 2).Value2
        Next d
    End With

    'reset the Questions worksheet
    With Worksheets("Questions")
        .Range(.Cells(2, 1), .Cells(.Rows.Count, 3).End(xlUp)).Interior.Pattern = xlNone
    End With

    'reset the Incorrect Mappings worksheet
    With Worksheets("Incorrect Mappings")
        .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Clear
    End With

    With Worksheets("Questions")
        For Each questionType In .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
            If Not CBool(InStr(1, questionType.Value2, "event", vbTextCompare)) Then
                vAIDs = Split(questionType.Offset(0, 1), Chr(59)) 'split on semi-colon
                For v = LBound(vAIDs) To UBound(vAIDs)
                    If dict.exists(vAIDs(v)) Then
                        If CBool(InStr(1, dict.Item(CStr(vAIDs(v))), "event", vbTextCompare)) Then
                            questionType.Resize(1, 3).Offset(0, -1).Interior.Color = vbRed
                            With Sheets("Incorrect Mappings")
                                .Hyperlinks.Add Anchor:=.Range("A" & .Rows.Count).End(xlUp).Offset(1, 0), _
                                                Address:="", SubAddress:=questionType.Address(external:=True), _
                                                ScreenTip:="click to go to rogue question", _
                                                TextToDisplay:="Question " & questionType.Offset(0, -1).Value2 & _
                                                               " should not have Event based frequency (" & _
                                                               vAIDs(v) & ")."
                            End With
                        End If
                    Else
                        questionType.Resize(1, 3).Offset(0, -1).Interior.Color = vbYellow
                        With Sheets("Incorrect Mappings")
                            .Hyperlinks.Add Anchor:=.Range("A" & .Rows.Count).End(xlUp).Offset(1, 0), _
                                            Address:="", SubAddress:=questionType.Address(external:=True), _
                                            ScreenTip:="click to go to rogue question", _
                                            TextToDisplay:="Question " & questionType.Offset(0, -1).Value2 & _
                                                           " references an unknown Answer ID (" & _
                                                           vAIDs(v) & ")."
                        End With
                    End If
                Next v
            End If
        Next questionType
    End With

End Sub

, , , , .