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