Moving text from cell 2 to cell 1

[Kilroy]

I have a table that has a clause number in the first column which is regular text and in the 2nd column there is sometimes a different number or letter but not always. need the identifier from column 2 to join with his brother in column 1. all are text a not number lists. Any help appreciated.




Current Table Rows






5.


Requirements Computer Programs








5.1


(a) identify extent which computer program conforms requirements Clauses 6 112








5.1


a) analysis shutdown system effectiveness








5.2


(i) change theoretical background








5.2


i) change data structure








5.2


1) change programming language








5.2


1. change computer program structure








5.2


(1). change computer program structure








5.2


Note: change embedded data eg correlations












Required Table Rows







5.


Requirements Computer Programs








5.1(a)


identify extent which computer program conforms requirements Clauses 6 112








5.1 a)


analysis shutdown system effectiveness








5.2(i)


change theoretical background








5.2 i)


change data structure








5.2 1)


change programming language








5.2 1.


change computer program structure








5.2(1).


change computer program structure








5.2 Note:


change embedded data eg correlations

[gmaxey]

You may have to tweak this:


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 9/18/2018
Dim arrWords() As String
Dim oRow As Row
Dim oRng As Range
Dim bClip As Boolean
For Each oRow In ActiveDocument.Tables(1).Rows
If oRow.Cells.Count = 4 Then
bClip = False
arrWords = Split(oRow.Cells(2).Range.Text, " ")
If Len(arrWords(0)) < 6 Then
If Left(arrWords(0), 1) = "(" Then bClip = True
If Right(arrWords(0), 1) = ")" Then bClip = True
If Right(arrWords(0), 1) = "." Then bClip = True
If arrWords(0) = "Note:" Then bClip = True
If bClip Then
Set oRng = oRow.Cells(1).Range
oRng.Collapse wdCollapseEnd
oRng.Move wdCharacter, -1
oRng.Text = " " & arrWords(0)
oRng.Font.Bold = False
Set oRng = oRow.Cells(2).Range
oRng.Collapse wdCollapseStart
oRng.MoveEnd wdCharacter, Len(arrWords(0)) + 1
oRng.Delete
End If
End If
End If
Next
lbl_Exit:
Exit Sub
End Sub

[Kilroy]

Greg I ran it on a couple different samples works perfect. I just need to make sure there is a space after ). Thanks Greg.