Consulting

Results 1 to 3 of 3

Thread: Moving text from cell 2 to cell 1

  1. #1
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    215
    Location

    Moving text from cell 2 to cell 1

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

  2. #2
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    2,845
    Location
    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
    Greg

    Visit my website: http://gregmaxey.com

  3. #3
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    215
    Location
    Greg I ran it on a couple different samples works perfect. I just need to make sure there is a space after ). Thanks Greg.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •