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 -
|