update cell when column header matches a list

Question

I am not the greatest at Excel vba but know enough to be dangerous.

I have Sheet1 which has records with App ID(A), status(B) and a free text field(C) we use for notes which can have many carriage returns or none.

Sheet2 contains a column for a flag name (columnA) and partial text (columnB) that needs to match to Sheet 1 notes(columnC)

I have code that creates Sheet 1 from reports and then takes the list from Sheet2,Column A and uses them as headers in Sheet 1.

I have code that I've manipulated to check if any part of the text in Column B in Sheet 2 exists in Column C in Sheet1 and if it does, mark column D in Sheet1 with a "1". The code works but I am needing to match up to the column names in Sheet 1 and update the appropriate column/flag. I've attached pictures to help show what I am needing and below is my code to date.

Sub Test()

Dim w1 As Worksheet
Dim w2 As Worksheet
Dim c As Range
Dim r As Range

Application.ScreenUpdating = False

Set w1 = Worksheets("sheet1")
Set w2 = Worksheets("sheet2")

For Each c In w2.Range("B2", w2.Range("B" & Rows.Count).End(xlUp)) 'loop through B
    Set r = w1.Columns(3).Find(What:=c.Value, LookIn:=xlFormulas, Lookat:=xlPart, MatchCase:=False, SearchFormat:=False)
    If Not r Is Nothing Then  'found in B
        w1.Range("E" & r.Row).Value = 1 'Update value to 1 if found.
    End If
Next c

Application.ScreenUpdating = True
    
    End Sub

Answer 1

• The 1st Dictionary object is used to store NI reason col index on Sheet1.

• The 2nd Dictionary object is used to store NI reason and trigger text.

Option Explicit
Sub Demo()
    Dim objDic1 As Object, objDic2 As Object
    Dim rngData As Range, vKey
    Dim i As Long, sKey As String, sReason As String
    Dim arrData
    Const COL_START = 4 ' the 1st NI reason col on Sheet1
    Set objDic1 = CreateObject("scripting.dictionary")
    Set objDic2 = CreateObject("scripting.dictionary")
    ' Load data from Sheet2
    arrData = Sheets("sheet2").Range("A1").CurrentRegion
    For i = LBound(arrData) + 1 To UBound(arrData)
        sKey = arrData(i, 2)
        If Not objDic2.exists(sKey) Then
            objDic2(sKey) = arrData(i, 1)
        End If
    Next i
    ' Load data from Sheet1
    Set rngData = Sheets("sheet1").Range("A1").CurrentRegion
    arrData = rngData.Value
    For i = 4 To UBound(arrData, 2)
        sKey = arrData(1, i)
        If Not objDic1.exists(sKey) Then
            objDic1(sKey) = i
        End If
    Next i
    ' Populate the data
    For i = LBound(arrData) + 1 To UBound(arrData)
        sKey = arrData(i, 3)
        For Each vKey In objDic2.Keys
            If InStr(1, sKey, vKey, vbTextCompare) > 0 Then
                sReason = objDic2(vKey)
                If objDic1.exists(sReason) Then
                    arrData(i, objDic1(sReason)) = 1
                End If
            End If
        Next
    Next i
    rngData.Value = arrData
End Sub

Microsoft documentation:

InStr function

Dictionary object