VBA Find and copy text with parentheses in a range of columns to new cell and clear old data

[BHW010116]

I am trying to figure out a way to search a range of columns for any thing that starts with an open parentheses and ends with a closing parentheses. Copy that data into one cell and then remove that txt from the original cells. I would prefer to do this using VBA instead of a formula but I am not sure how to get this to work. Any ideas? I posted what my data currently looks like and what I am trying to get my data to look like.

A	B	C	D	E
W & V	DO NOT RUN WITHOUT AIRFLOW	(MUST SEND 07H0105-01	WITH UNIT 2PCS PER)
W & V	DO NOT RUN WITHOUT AIRFLOW	(MUST SEND 07H0105-01	WITH UNIT 2PCS PER)
650W 120V	DO NOT RUN WITHOUT AIRFLOW	(THIS ETCH IS CORRECT) Watts
1000W 120V	"DO NOT RUN WITHOUT AIRFLOW"	(SEND TO HDA FOR HARDWARE)
3000W 230V	"DO NOT RUN WITHOUT AIRFLOW"	(SEND BACK TO HDA FOR	COMPLETION)
NECKDOWN AREA/ETCH AS CLOSE TO	BOTTOM OF UNIT AS POSSIBLE	/(SEND UNIT TO SLCT	TO BE FINISHED)
Company	"DO NOT RUN WITHOUT AIRFLOW"	(send Unit	To SLCT to	Be Finished)

<tbody>
</tbody>

A	B	C	D	E	F
W & V	DO NOT RUN WITHOUT AIRFLOW				(MUST SEND 07H0105-01 WITH UNIT 2PCS PER)
W & V	DO NOT RUN WITHOUT AIRFLOW				(MUST SEND 07H0105-01 WITH UNIT 2PCS PER)
650W 120V	DO NOT RUN WITHOUT AIRFLOW	Watts			(THIS ETCH IS CORRECT)
1000W 120V	"DO NOT RUN WITHOUT AIRFLOW"				(SEND TO HDA FOR HARDWARE)
3000W 230V	"DO NOT RUN WITHOUT AIRFLOW"				(SEND BACK TO HDA FOR COMPLETION)
NECKDOWN AREA/ETCH AS CLOSE TO	BOTTOM OF UNIT AS POSSIBLE	/			(SEND UNIT TO SLCT TO BE FINISHED)
company	Do not run without airflow				(SEND UNIT TO SLCT TO BE FINISHED)

<tbody>
</tbody>

 

[Rick Rothstein]

Give this macro a try...

[table="width: 500"]
[tr]
	[td]Sub CombineAndMoveTextInParentheses()
  Dim R As Long, LastCol As Long, Txt() As String
  LastCol = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious, , , False).Column
  For R = 1 To Cells(Rows.Count, "A").End(xlUp).Row
    Txt = Split(Replace(Application.Trim(Join(Application.Index(Range(Cells(R, "C"), Cells(R, LastCol)).Value, 1, 0))), ")", "("), "(")
    Range(Cells(R, "C"), Cells(R, LastCol)).Clear
    Cells(R, "C").Value = Application.Trim(Txt(0) & " " & Txt(2))
    Cells(R, LastCol + 1) = "(" & Txt(1) & ")"
  Next
End Sub[/td]
[/tr]
[/table]