How to Re-arrange large field lines in talble

PRA007 · #1 03-14-2015, 03:19 AM

I have large text file having repeating lines as follow

I want to fit the text in the table like this

I have following macro but the problem is it is for small text. I don't know how to loop. I optionally made repeatations but it throws error after say 20 repetition. my macro is as following:

Sub PLR()
'
' PLR Macro
'
'
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.WholeStory
Selection.Font.Name = "Palatino Linotype"
Selection.Font.Size = 12
If Selection.PageSetup.Orientation = wdOrientPortrait Then
Selection.PageSetup.Orientation = wdOrientLandscape
Else
Selection.PageSetup.Orientation = wdOrientLandscape
End If
Selection.ConvertToTable Separator:=wdSeparateByParagraphs, NumColumns:=1, _
NumRows:=954, AutoFitBehavior:=wdAutoFitFixed
With Selection.Tables(1)
If .Style <> "Table Grid" Then
.Style = "Table Grid"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With
Selection.InsertColumns
Selection.InsertColumns
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Tables(1).Columns(2).SetWidth ColumnWidth:=206.7, RulerStyle:= _
wdAdjustNone
Selection.Tables(1).AllowAutoFit = False
Selection.Tables(1).Columns(1).SetWidth ColumnWidth:=206, RulerStyle:= _
wdAdjustNone
Selection.Tables(1).Columns(3).SetWidth ColumnWidth:=418.5, RulerStyle:= _
wdAdjustNone

Selection.MoveRight Unit:=wdCell

Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.Cut
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis)
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.Cut
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis)
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.Cut
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Selection.TypeText Text:="Abstract:"
Selection.TypeParagraph
Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis)
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.EndKey Unit:=wdLine
Selection.TypeText Text:="."
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Cut
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.PasteAndFormat (wdPasteDefault)
Selection.EndKey Unit:=wdLine
Selection.TypeBackspace
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveDown Unit:=wdLine, Count:=3, Extend:=wdExtend
Selection.Cells.Delete ShiftCells:=wdDeleteCellsEntireRow
Selection.TypeBackspace
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.Cut
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis)
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.Cut
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis)
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.Cut
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Selection.TypeText Text:="Abstract:"
Selection.TypeParagraph
Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis)
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.EndKey Unit:=wdLine
Selection.TypeText Text:="."
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Cut
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.PasteAndFormat (wdPasteDefault)
Selection.EndKey Unit:=wdLine
Selection.TypeBackspace
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveDown Unit:=wdLine, Count:=3, Extend:=wdExtend
Selection.Cells.Delete ShiftCells:=wdDeleteCellsEntireRow
Selection.TypeBackspace
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.Cut
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis)
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.Cut
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis)
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.Cut
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Selection.TypeText Text:="Abstract:"
Selection.TypeParagraph
Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis)
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.EndKey Unit:=wdLine
Selection.TypeText Text:="."
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Cut
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.PasteAndFormat (wdPasteDefault)
Selection.EndKey Unit:=wdLine
Selection.TypeBackspace
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveDown Unit:=wdLine, Count:=3, Extend:=wdExtend
Selection.Cells.Delete ShiftCells:=wdDeleteCellsEntireRow
Selection.TypeBackspace

gmayor · #2 03-15-2015, 01:26 AM

Ouch!

Try the following instead. This will work as long as the repeats are as show and there is a multiple of 5 lines in the source.

Code:

Option Explicit

Sub PLR()
'Macro by Graham Mayor 2015
Dim oSource As Document
Dim oTarget As Document
Dim oTable As Table
Dim oRow As Row
Dim oCell As Range
Dim oPara As Range
Dim i As Long
    Set oSource = ActiveDocument
    Set oTarget = Documents.Add
    'Setup the table document
    oTarget.PageSetup.PaperSize = wdPaperLetter
    oTarget.PageSetup.Orientation = wdOrientLandscape
    oTarget.PageSetup.LeftMargin = InchesToPoints(0.35)
    oTarget.PageSetup.RightMargin = InchesToPoints(0.25)
    'Setup the table size
    Set oTable = oTarget.Tables.Add(oTarget.Range, 1, 3)
    With oTable
        .Style = "Table Grid"
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
        .ApplyStyleRowBands = True
        .ApplyStyleColumnBands = False
        .AllowAutoFit = False
        .Columns(1).SetWidth _
                ColumnWidth:=206, _
                RulerStyle:=wdAdjustNone
        .Columns(2).SetWidth _
                ColumnWidth:=206, _
                RulerStyle:=wdAdjustNone
        .Columns(3).SetWidth _
                ColumnWidth:=338, _
                RulerStyle:=wdAdjustNone
    End With
    On Error GoTo lbl_Exit
    For i = 1 To oSource.Paragraphs.Count Step 5
        Set oRow = oTable.Rows.Last
        Set oPara = oSource.Paragraphs(i).Range
        'Process column 3
        Set oCell = oRow.Cells(3).Range
        oCell.End = oCell.End - 1
        oCell.FormattedText = oPara.FormattedText
        Set oPara = oSource.Paragraphs(i + 3).Range
        oPara.End = oPara.End - 1
        oCell.Collapse 0
        oCell.Text = "Add some text" & vbCr
        oCell.Collapse 0
        oCell.FormattedText = oPara.FormattedText

        'Process column 2
        Set oCell = oRow.Cells(2).Range
        oCell.End = oCell.End - 1
        Set oPara = oSource.Paragraphs(i + 4).Range
        oCell.FormattedText = oPara.FormattedText

        'Process column 1
        Set oCell = oRow.Cells(1).Range
        oCell.End = oCell.End - 1
        Set oPara = oSource.Paragraphs(i + 2).Range
        oCell.FormattedText = oPara.FormattedText
        oCell.Collapse 0
        Set oPara = oSource.Paragraphs(i + 1).Range
        oPara.End = oPara.End - 1
        oCell.FormattedText = oPara.FormattedText
        'If not the end of the list add a row
        'Assumes no blank paragraphs at the end
        If i < oSource.Paragraphs.Count - 4 Then oTable.Rows.Add
        DoEvents
    Next i
    'Format the table
    With oTable
        .Range.Font.name = "Palatino Linotype"
        .Range.Font.Size = 12
        .Range.ParagraphFormat.SpaceAfter = 0
        .Range.LanguageID = wdEnglishUS
    End With
lbl_Exit:
    'Clean up
    Set oSource = Nothing
    Set oTarget = Nothing
    Set oTable = Nothing
    Set oRow = Nothing
    Set oCell = Nothing
    Set oPara = Nothing
    Exit Sub
End Sub

PRA007 · #3 03-16-2015, 03:33 AM

The VBA works perfectly. Only thing to notice is in last five lines title3 and title2 not comming. Not problem for me just for your knowledge.
Sorry My problem. Working fine. Thak you very much.

PRA007 · #4 03-18-2015, 01:58 AM

Quote:

Originally Posted by gmayor

Ouch!

Try the following instead. This will work as long as the repeats are as show and there is a multiple of 5 lines in the source.

Code:

Option Explicit

Sub PLR()
'Macro by Graham Mayor 2015
Dim oSource As Document
Dim oTarget As Document
Dim oTable As Table
Dim oRow As Row
Dim oCell As Range
Dim oPara As Range
Dim i As Long
    Set oSource = ActiveDocument
    Set oTarget = Documents.Add
    'Setup the table document
    oTarget.PageSetup.PaperSize = wdPaperLetter
    oTarget.PageSetup.Orientation = wdOrientLandscape
    oTarget.PageSetup.LeftMargin = InchesToPoints(0.35)
    oTarget.PageSetup.RightMargin = InchesToPoints(0.25)
    'Setup the table size
    Set oTable = oTarget.Tables.Add(oTarget.Range, 1, 3)
    With oTable
        .Style = "Table Grid"
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
        .ApplyStyleRowBands = True
        .ApplyStyleColumnBands = False
        .AllowAutoFit = False
        .Columns(1).SetWidth _
                ColumnWidth:=206, _
                RulerStyle:=wdAdjustNone
        .Columns(2).SetWidth _
                ColumnWidth:=206, _
                RulerStyle:=wdAdjustNone
        .Columns(3).SetWidth _
                ColumnWidth:=338, _
                RulerStyle:=wdAdjustNone
    End With
    On Error GoTo lbl_Exit
    For i = 1 To oSource.Paragraphs.Count Step 5
        Set oRow = oTable.Rows.Last
        Set oPara = oSource.Paragraphs(i).Range
        'Process column 3
        Set oCell = oRow.Cells(3).Range
        oCell.End = oCell.End - 1
        oCell.FormattedText = oPara.FormattedText
        Set oPara = oSource.Paragraphs(i + 3).Range
        oPara.End = oPara.End - 1
        oCell.Collapse 0
        oCell.Text = "Add some text" & vbCr
        oCell.Collapse 0
        oCell.FormattedText = oPara.FormattedText

        'Process column 2
        Set oCell = oRow.Cells(2).Range
        oCell.End = oCell.End - 1
        Set oPara = oSource.Paragraphs(i + 4).Range
        oCell.FormattedText = oPara.FormattedText

        'Process column 1
        Set oCell = oRow.Cells(1).Range
        oCell.End = oCell.End - 1
        Set oPara = oSource.Paragraphs(i + 2).Range
        oCell.FormattedText = oPara.FormattedText
        oCell.Collapse 0
        Set oPara = oSource.Paragraphs(i + 1).Range
        oPara.End = oPara.End - 1
        oCell.FormattedText = oPara.FormattedText
        'If not the end of the list add a row
        'Assumes no blank paragraphs at the end
        If i < oSource.Paragraphs.Count - 4 Then oTable.Rows.Add
        DoEvents
    Next i
    'Format the table
    With oTable
        .Range.Font.name = "Palatino Linotype"
        .Range.Font.Size = 12
        .Range.ParagraphFormat.SpaceAfter = 0
        .Range.LanguageID = wdEnglishUS
    End With
lbl_Exit:
    'Clean up
    Set oSource = Nothing
    Set oTarget = Nothing
    Set oTable = Nothing
    Set oRow = Nothing
    Set oCell = Nothing
    Set oPara = Nothing
    Exit Sub
End Sub

Macro works fine, but in column 2 at the end of line it shows paragraph mark. I tried to remove that mark by modifying the macro but failed. Could you please tell me how to remove paragraph mark at the end of Column 2. I want to add paragraph at the end of column 1 as I want to process the same using other macro.

gmayor · #5 03-18-2015, 02:24 AM

Use the following instead

Code:

'Process column 2
        Set oCell = oRow.Cells(2).Range
        oCell.End = oCell.End - 1
        Set oPara = oSource.Paragraphs(i + 4).Range
        oPara.End = oPara.End - 1
        oCell.FormattedText = oPara.FormattedText

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Extra lines in directroy when field is blank	redzan	Mail Merge	5	05-23-2014 06:40 PM
Re-Arrange Generated Data	flds	Excel	4	06-29-2012 08:17 AM
Large amount of text as a form field.	JustK	Word	2	11-15-2011 11:17 AM
Large gap between lines.	Balliol	Word	8	12-14-2010 04:59 PM
Text Wrapping on Fixed Lines in a Form field/Table cell	okrmjr	Word Tables	0	10-30-2009 08:52 AM