Thanks Bob. I was so close.

Dominique
"Bob Phillips" wrote in message
...
Dominique.

Try this

Sub Move()
Dim oCell As Range
Dim sStart As String
With Columns("A:A")
Set oCell = .Find(What:="Diary")
If Not oCell Is Nothing Then
Do
oCell.Copy Destination:=oCell.Offset(0, 4)
oCell.Value = ""
sStart = oCell.Address
Set oCell = .FindNext(oCell)
Loop While Not oCell Is Nothing
End If
End With

End Sub



--

HTH

RP
(remove nothere from the email address if mailing direct)


"Dominique Feteau" wrote in message
...
This idea works, but not how i need it to work. the reason i used the
.find
method is because "Diary" is the first word in each cell that I want
moved
to the 4th column. for example: in A2 = Diary Date 510, in A45 = Diary
Date
520. I did create a slimmed down version of my macro, but still cant
figure
out how to make it loop.

Sub Move()

Columns("A:A").Select
Cells.Find(What:="Diary", After:=ActiveCell,
LookIn:=xlValues).Activate
Selection.Cut
ActiveCell.Offset(columnOffset:=4).Activate
ActiveSheet.Paste

End Sub

"R.VENKATARAMAN" &&& wrote in message
...
many solutions
your data is A3 to A10
try this macro

Option Explicit

Public Sub test()
Dim cell As Range
For Each cell In Range("a3:a10")
If cell = "dairy" Then cell.Offset(0, 4) = cell
Next
End Sub

the statement after <then can be any action

=======================
Dominique Feteau wrote in message
...
I have a macro that will search Column A for the word "Diary", select
that
cell, and move the contents of that cell over 4 columns. I want it to
look
through the entire column and continue till it doesnt find the word
"diary"
in column A. How do I do that?

Sub Move()

Columns("A:A").Select
Cells.Find(What:="Diary", After:=ActiveCell, LookIn:=xlFormulas,
LookAt
_
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Selection.Cut
ActiveCell.Offset(columnOffset:=4).Activate
ActiveSheet.Paste

End Sub