View Single Post
  #9   Report Post  
Posted to microsoft.public.excel.programming
Per Jessen Per Jessen is offline
external usenet poster
 
Posts: 1,533
Default Limit .find to one pass

Hi Robert

Thanks for your reply, I'm glad you made it work.

Regards,
Per

"Robert H" skrev i meddelelsen
...
Per, It works now. I had to make one more modification:
Cells.findnext(ActiveCell).Activate
otherwise it would just go back an work the same column one time and
then exit.
Thanks very much for the help
Robert

Final code:

Sub ConvPMFLTSMoveLCIDtoNextCol()

Dim r As Long
Dim r2
Dim startCell As Range
Dim findnext

r = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row - 1

Range("a1").Select

'Code mosdifications from Per Jessen

Cells.Find(what:="LC", After:=ActiveCell, LookIn:=xlValues, _
lookat:=xlPart, searchorder:=xlByColumns, SearchDirection:=xlNext,
_
MatchCase:=False, SearchFormat:=False).Activate

Set startCell = ActiveCell

Do
ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.Value = ""
'Copy the right-most character to the next column
ActiveCell.Offset(0, 1).Value = Right$(ActiveCell.Value,
1)
'Cut off the right-most character
ActiveCell.Value = Left$(ActiveCell.Value, Len
(ActiveCell.Value) - 1)
'ActiveCell = ActiveCell.Offset(1, 0)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-r, 1).Select 'move up and to next column
Cells.findnext(ActiveCell).Activate
Loop Until ActiveCell.Address = startCell.Address

End Sub

On Dec 19, 9:04 am, Per Jessen wrote:
Robert

Change
FindNext.Activate

to:

Cells.FindNext.Activate

Regards,
Per

On 19 Dec., 14:19, Robert H wrote:



Per,
the code manipulates the first column correctly but at the
FindNext.Activate line I'm receiving a Runtime Error 424 "Object
Required" error. I tried to fix it but did not make any progress.
thanks
Robert


On Dec 18, 11:57 am, "Per Jessen" wrote:


Hi Robert


I think this should do it:


Cells.Find(what:="LC", After:=ActiveCell, LookIn:=xlValues, _
lookat:=xlPart, searchorder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Set Startcell = ActiveCell
Do
ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.Value = ""
'Copy the right-most character to the next column
ActiveCell.Offset(0, 1).Value = Right$(ActiveCell.Value, 1)
'Cut off the right-most character
ActiveCell.Value = Left$(ActiveCell.Value, Len(ActiveCell.Value) -
1)
'ActiveCell = ActiveCell.Offset(1, 0)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-r, 1).Select 'move up and to next column
FindNext.Activate
Loop Until ActiveCell.Address = Startcell.Address


Regards,
Per


"Robert H" skrev i
...


The following code loops through certain columns and removes the
last
character in the data. My data arrangement has changed a little and
now the code continuously loops through the data removing the last
character until there is not data. Its funny to watch but I need to
fix it...


How can I limit the code to make just one pass? Too bad there is not
a
"before" attribute.


thanks
Robert


Do Until ActiveCell.Value = ""


Cells.Find(what:="LC", After:=ActiveCell, LookIn:=xlValues,
lookat:= _
xlPart, searchorder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:=
False, SearchFormat:=False).Activate


ActiveCell.Offset(1, 0).Select


Do Until ActiveCell.Value = ""


'Copy the right-most character to the next column
ActiveCell.Offset(0, 1).Value = Right$
(ActiveCell.Value, 1)
'Cut off the right-most character
ActiveCell.Value = Left$(ActiveCell.Value, Len
(ActiveCell.Value) - 1)
'ActiveCell = ActiveCell.Offset(1, 0)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-r, 1).Select 'move up and to next column


Loop- Hide quoted text -


- Show quoted text -- Skjul tekst i anførselstegn -


- Vis tekst i anførselstegn -- Hide quoted text -


- Show quoted text -