identify that cell with the text in column A and insert a formula

Question

I have a sheet which has a specific text occurring once in a range. I want to identify that cell with the text in column A and insert a formula

My excel sheet has a text called "Weighted" in Column A. This is between the range A152:A200. I want to identify this word in the range and write a formula in column I. Assuming this word is in A162, the formula in corresponding I162 should be I152(This is always the same):I161 (Always one row ahead of the word weighted)

If the word weighted occurs in A160, the formula in I160 should be sum(I152:I159). Any ideas how this can be done. I have tried the below code but am unable to proceed

Dim ws As Worksheet, sCellVal As String
    Dim Q As Range
Set ws = ActiveSheet

For Each Q In Range("A152:A200")

sCellVal = Q.Text

 If sCellVal Like "*Weighted:*" Then Offset(8,0)

Answer 1

Please check if I had understood your question:

Dim ws As Worksheet
Dim Q As Range
Set ws = ActiveSheet

For Each Q In ws.Range("A152:A200")

If Q.Value Like "*Weighted:*" Then
    ' Assign a formula to I Column
    ws.Range("I" & Q.Row).Formula = "=SUM(I152:I" & Q.Row - 1 & ")"
    Exit For
End If

Next

Answer 2

Try this code out :

Sub findweighted()
Dim i As Integer

For i = 152 To 200
    DoEvents
        If InStr(Range("a" & i), "Weighted") Or InStr(Range("a" & i), "weighted") Then
        Range("a" & i).Offset(0, 8).Formula = "=sum(i152:i" & i - 1 & ")"
 
    Else
    End If
Next


End Sub

Answer 3

Identify Cell Using the Find Method

Option Explicit

Sub writeFormula()

    Const wsName As String = "Sheet1"
    Const FormulaColumn As Variant = "I"
    Const CriteriaAddress As String = "A152:A200"
    Const Criteria As String = "Weighted:"
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim rng As Range: Set rng = ws.Range(CriteriaAddress)
    
    Dim cel As Range
    ' Either case-insensitive i.e. "W" = "w":
    Set cel = rng.Find(Criteria, rng.Cells(rng.Rows.Count), xlValues, xlPart)
    ' Or case-sensitive i.e. "W" <> "w":
    'Set cel = rng.Find(Criteria, rng.Cells(rng.Rows.Count), xlValues, xlPart, _
                       , , True)
    If cel Is Nothing Then Exit Sub
    If cel = rng.Cells(1) Then Exit Sub
    
    Dim Offs As Long
    Offs = ws.Columns(FormulaColumn).Column - ws.Range(CriteriaAddress).Column
    
    Set rng = ws.Range(rng.Cells(1), cel.OffSet(-1)).OffSet(, Offs)
    Set cel = cel.OffSet(, Offs)
    
    cel.Formula = "=SUM(" & rng.Address(False, False) & ")"

End Sub