Need help in vba populating data based on a certain column

This is how row 1028 look like

Yield Curve Name	Term	Term Type	Current Qtr	Previous Qtr	Variance	Variance %	Currency	Blank Column	VAR TOLERANCE FLAG	YC ABOVE TOLERANCE	Variance in Abs
CAD_CAD_OIS	1D	Days	0.71537	4.7487	-4.0339	-84.935%	CAD		VAR GT TOLERANCE	YC within tolerance	0.84

requirement is to use VBA code to populate the "YC ABOVE TOLERANCE" column based on the values in the "VAR TOLERANCE FLAG" column for a given Excel sheet named "QRM_YC_QoQ_Checks." If any term point for a specific yield curve has the value "VAR GT TOLERANCE" in the "VAR TOLERANCE FLAG" column, then all term points for that curve should be marked as "YC above tolerance" in the "YC ABOVE TOLERANCE" column. If the term point does not breach the threshold, it should be marked as "YC within tolerance." The code should dynamically handle different curves in column A and work with the entire dataset in the sheet.

here is the code i have written but its not serving the purpose

Here is the vba code

Sub PopulateYCToleranceFlagField()
    Application.DisplayStatusBar = True
    
    Dim MyYieldCurveCellRowCounter As Long
    Dim MyVarToleranceCell As Range
    Dim MyLastRow As Long
    Dim ws As Worksheet
    Dim MyLastYieldCurveGTTolerance As String
    
    ' Set the worksheet reference
    Set ws = ThisWorkbook.Sheets("QRM_YC_QoQ_Checks")
    
    ' Find the last used row in column A
    MyLastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' Initialize the row counter
    MyYieldCurveCellRowCounter = 2 ' Assuming the data starts from row 2 in column A
    
    ' Initialize the variable to track the last yield curve
    MyLastYieldCurveGTTolerance = " "
    
    ' Loop through the data in column A
    Do While ws.Cells(MyYieldCurveCellRowCounter, 1).Value <> ""
        If ws.Cells(MyYieldCurveCellRowCounter, 1).Value <> MyLastYieldCurveGTTolerance Then
            Application.StatusBar = MyYieldCurveCellRowCounter & " of " & MyLastRow - 1 & " rows - Yield curve ==> " & ws.Cells(MyYieldCurveCellRowCounter, 1).Value
            DoEvents
            
            ' Check if any cell in column J has "VAR GT TOLERANCE"
            If WorksheetFunction.CountIf(ws.Range(ws.Cells(4, 10), ws.Cells(MyLastRow - 1, 10)), "VAR GT TOLERANCE") > 0 Then
                ' If true, populate "YC above Tolerance" for the entire yield curve in column K
                ws.Range(ws.Cells(4, 11), ws.Cells(MyLastRow - 1, 11)).Value = "YC above Tolerance"
            End If
            
            ' Update the last yield curve
            MyLastYieldCurveGTTolerance = ws.Cells(MyYieldCurveCellRowCounter, 1).Value
        End If
        
        ' Move to the next row
        MyYieldCurveCellRowCounter = MyYieldCurveCellRowCounter + 1
    Loop
    
    ' Clear the status bar
    Application.StatusBar = " "
End Sub

Solution

Load data into an array
Check YC ABOVE TOLERANCE status and store in Dictionary object
Populate column K all at once

Option Explicit
Sub Demo3()
    Dim i As Long, arrData, arrK(), oSht as Worksheet
    Dim LastRow As Long, oDic, sKey As String
    Const KEYWORD = "VAR GT TOLERANCE"
    Const SHT_NAME = "QRM_YC_QoQ_Checks" ' modify as needed
    Set oSht = Sheets(SHT_NAME)
    LastRow = oSht.Cells(oSht.Rows.Count, "A").End(xlUp).Row
    arrData = oSht.Range("A2:J" & LastRow).Value
    ReDim arrK(1 To LastRow - 1, 1 To 1)
    Set oDic = CreateObject("scripting.dictionary")
    For i = LBound(arrData) To UBound(arrData)
        sKey = arrData(i, 1)
        If Not oDic.exists(sKey) Then oDic(sKey) = False
        If UCase(arrData(i, 10)) = KEYWORD Then
            oDic(sKey) = True
        End If
    Next i
    For i = LBound(arrData) To UBound(arrData)
        If oDic(arrData(i, 1)) Then
            arrK(i, 1) = "YC above tolerance"
        Else
            arrK(i, 1) = "YC within tolerance"
        End If
    Next i
    oSht.Range("K2:K" & LastRow).Value = arrK
End Sub

Microsoft documentation:

Dictionary object