How to get my code to loop
 

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

How to get my code to loop
 

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

How to get my code to loop
 

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

How to get my code to loop
 

Hi Dominique,

Using the Find/FindNext method, try:

Sub Move()
Dim c As Range
Dim firstAddress As String
Dim rng As Range
Dim sStr As String
sStr = "Diary"
With ActiveSheet.Columns("A:A")
On Error Resume Next
Set c = .Find(What:=sStr, _
After:=ActiveSheet.Range("A1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
On Error GoTo 0
If Not c Is Nothing Then
firstAddress = c.Address
Do
If Not rng Is Nothing Then
Set rng = Union(rng, c)
Else
Set rng = c
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address _
< firstAddress
rng.ClearContents
rng.Offset(0, 4) = sStr
End If
End With
End Sub

---
Regards,
Norman



"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

How to get my code to loop
 

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

How to get my code to loop
 

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