Search within a column and repeat the search until all items are found

Not sure about what you mean by freeze. But maybe?

Sub RandyLiposki()
Dim rcell As Range
For Each rcell In Range("H2:H" & ActiveSheet.UsedRange.Rows.Count + 1)
    If rcell.Value Like "*TODAY*" Then
        rcell.Offset(, -1).Value = rcell.Offset(, -1).Value
    End If
Next rcell
End Sub

Thanks much for your responses. Neither macro was able to find the word "TODAY". Perhaps I misinterpreted what I was supposed to do but I copied them essential verbatim.

I attempted to attach an image of the spreadsheet so you could see exactly what I am talking about but it doesn't look like it worked.

The macro simply needs to go from 1 cell to another in column H looking for the word "TODAY". If you can get me that far, I can take it the rest of the way.

TODAY.JPG

Both codes should do that. If they are not working can you provide a sample with some data as depicted in the .jpg file?

Sub RandyLiposki()
Dim rcell As Range
For Each rcell In Range("H2:H" & ActiveSheet.UsedRange.Rows.Count + 1)
    If rcell.Value = "TODAY" Then
        rcell.Offset(, -1).Value = rcell.Offset(, -1).Value
    End If
Next rcell
End Sub

Still did not work. Here is a sample of the forumulas used in those columns

TODAY1.JPG

I meant attaching a sample worksheet with some data which is not responding to the macros. To attach a file, push the button with the paperclip (or scroll down to the Manage Attachments button), browse to the required file, and then push the Upload button.

PS: There is a Loop statement that I inadvertently left out

Sorry for the delay. I have attached a copy of the file that I am using with the macro

SUMMARY2.xlsm

Here is a copy of the macro I am attempting to use. Again, the intent of the macro is to freeze the dates in Column G.

Do
    Cells.Find(What:="TODAY", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Offset(0, -1).Activate
    'Freezing of date will occur here
    ActiveCell.Offset(0, 1).Activate
    Selection.ClearContents
    
  If Selection.Value = "" Then Exit Do
    
Loop

For those that are interested, I finally got this macro to work. This is a handy little macro and may be beneficial to those that search for specific words in a column or row.

Do
      
    Cells.Find(What:="TODAY", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Offset(0, -1).Activate
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    ActiveCell.Offset(0, 1).Activate
    Selection.ClearContents
    On Error GoTo ErrorHandler:

  Loop
'ERRORHANDLER NEEDED TO PREVENT ERROR MESSAGE DURING SEARCH FOR "TODAY"
ErrorHandler:
Range("H2000").Select
ActiveCell.FormulaR1C1 = "TODAY" 'PLACES ANOTHER TODAY AT CELL H2000 TO PREVENT ERROR DURING MULTIPLE SAVES ON SAME DAY
Range("A6").Select
      ActiveSheet.Protect

Thanks much for all of your effort. I have managed to get the find function working with a Do Loop. It moves sucessfully from "Today" to "Today" but when it gets to the last "Today" the macro freezes and won't fully complete the macro. I don't have the ability to attach the spreadsheet.

Here's my current macro

Sub FREEZEDATE()
'
' FREEZES DATES ON SUMMARY PAGE'

'
Sheets("SUMMARY").Select
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Application.Goto Reference:="TOP"

Do
   
   Cells.Find(What:="TODAY", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Offset(0, -1).Activate
    'Freezing of date will occur here
    ActiveCell.Offset(0, 1).Activate
    Selection.ClearContents
    ActiveCell.Activate
    If Not Selection.Value = "" Then Exit Do
     
      Range("A6").Select
      ActiveSheet.Protect

End Sub