VBA help needed to find text string, clear cells then add new cell value

Folks,

Please help me to build a Macro to search text string "WorkPack Approval:" in Column A, then clear all contents from cell contains text string "WorkPack Approval:" to just above text string "Comments:". And add new cell value in the same cell as "LOG BOOK:"

I have attached the work book of what I am trying to accomplish.


Thanks in advance for your time and expertise

Try this, but those merged cells are horrible:

Sub x()
  
Dim rFind1 As Range, rFind2 As Range
 
With Sheet1.UsedRange
    Set rFind1 = .Find(What:="Workpack Approval:", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
    If Not rFind1 Is Nothing Then
        Do
            Set rFind2 = .Find(What:="Comments:", After:=rFind1, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
            If Not rFind2 Is Nothing Then
                With Range(rFind1, rFind2.Offset(-1)).Resize(, 6)
                    .ClearContents
                    .Interior.Color = vbYellow
                    .Merge
                    .Value = "LOG BOOK"
                    .Font.Size = 48
                    .HorizontalAlignment = xlCenter
                End With
                Set rFind1 = .Find(What:="Workpack Approval:", After:=rFind2, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
            End If
        Loop While Not rFind1 Is Nothing
    End If
End With
     
End Sub

Hi Stephen & ragulduy,

Thanks you so much gents. Your code is working excellent.


Joshi