Cut & past

[Manolocs]

Hi, I have two columns with text. some of the rows has a (text) in front of the text, is there a way to move this (text) to the end of the text of the other column?
[TABLE="width: 10"]
<tbody>[TR]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[/TR]
[TR]
[TD](1)One[/TD]
[TD]One[/TD]
[/TR]
[TR]
[TD](car) Red[/TD]
[TD]Red[/TD]
[/TR]
[TR]
[TD](above)blue[/TD]
[TD]Something [/TD]
[/TR]
</tbody>[/TABLE]

The result I need is:


[TABLE="width: 10"]
<tbody>[TR]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[/TR]
[TR]
[TD]One[/TD]
[TD]One (1)[/TD]
[/TR]
[TR]
[TD]Red[/TD]
[TD]Red (car)[/TD]
[/TR]
[TR]
[TD]blue[/TD]
[TD]Something(above)[/TD]
[/TR]
</tbody>[/TABLE]


thanks in advance

 

[mumps]

Try:

Sub Test()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    Dim val As String
    For Each rng In Range("A1:A" & LastRow)
        val = Split(rng, ")")(0)
        rng.Offset(0, 1) = rng.Offset(0, 1) & val & ")"
        rng = Mid(rng, WorksheetFunction.Find(")", rng) + 1, 999)
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[Rick Rothstein]

See if this non-looping code does what you want...

[table="width: 500"]
[tr]
	[td]Sub MoveTextInParenthesesFromColumnAtoColumnB()
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Range("B1:B" & LastRow) = Evaluate(Replace("IF(B1:B#="""","""",B1:B#&"" ""&LEFT(A1:A#,FIND("")"",A1:A#&"")"")))", "#", LastRow))
  Columns("A").Replace ") ", ")", xlPart
  Columns("A").Replace "*)", "", xlPart
End Sub[/td]
[/tr]
[/table]

 

[Manolocs]

Thank you mumps, works very well.

 

[Manolocs]

@Rick Rotstein, your code worked as well Thank you very much.