Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Split table into multiple tables 4

Status
Not open for further replies.

PStrongs

Instructor
Oct 30, 2007
30
0
0
GB
Hi Everyone,

I have a .txt file that has been exported from Business Objects. I am formatting the file as a word document and then converting the text to a table. The resulting table can be in excess of 2000 rows. Each range of data within the table is separated by a blank row. I want to split the table into multiple tables at the blank row separating the data range.

I have tried the following code snippet, but the loop ceases at the first split (because the table is now two tables and not one table).

Can anyone tell me how to continue with the loop until all blank rows have been found leaving me with a separate table for each data range.

I know this may be a slow process due to the way that tables work in Word. Is there a way to do this in Excel, but reference the Excel document from within Word? I will need to find text in each data range, hence the need for separate tables.

Dim eRow as Row
Dim newTable as Table
Dim targetDoc as Document

For Each eRow In newTable.Rows
i = targetDoc.Tables.Count
Set newTable = targetDoc.Tables(i)
eRow.Select
If eRow.Cells(3).Range.Text = Chr(13) & Chr(7) Then
Selection.SplitTable
Selection.MoveDown wdLine, 1, wdMove
eRow.Select
End If
Next
Next
 
why would you do this in Word rather than Excel ?

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question
 
I'm sure it's easy enough to use Excel but I don't think you need to. The trick, as with so many table iterations is to go backwards.
Code:
Sub tsplit()
    n = 1
    Set tb = ActiveDocument.Tables(1)
    Do While n > 0
        For Each r In tb.Rows
            If r.Cells(1).Range = Chr(13) & Chr(7) Then n = r.Cells(1).RowIndex
        Next
        If n = 1 Then Exit Do
        tb.Split (n)
        n = 1
    Loop
End Sub


_________________
Bob Rashkin
 
Hi Geoff,

Excel may be the better option from a speed point of view, but the document that I am working in is a Word document. So I am finding text in a data range, if the search meets the criteria, the found text is assigned to a table in the main document. With a word table, I can search for the text required (there may be more than one instance of the text) and use the table as the range to search. Each search would be specific to one data range and not the whole text before splitting the table.

Bong,

thanks for your suggestion. I will give this a try on Monday and let you know if it works.

Thank you both and have a great weekend.

Regards,
 
Hi Bong,

Hope you had a great weekend.

Been tinkering with your code on a document and it seems to go into an infinite loop.

I have used my own variables as follows:
Code:
Dim eRow as Row
Dim newTable as Table
Dim i as Long

Set newTable = ActiveDocument.Tables(1)

i = 1
     Do While i > 0
         For Each eRow In newTable.Rows
           If eRow.Cells(1).Range = Chr(13) & Chr(7) Then
             i = eRow.Cells(1).RowIndex
              If i = 1 Then
                Exit Do
               newTable.Split (i)
             i = 1
         End If
      End If
  Next
Loop

Hope you can help.

Regards,
 
PStrongs - Fair enough - just saw .txt file, BusObj and sorting through data and my 1st thought was "easier in excel"

Looks like you have a Word method that sould work courtesy of Bong so I shall retire from this thread ;-)

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question
 
You need to put the newTable.split(i) statement [red]outside[/red] the if...exit do...then structure.

_________________
Bob Rashkin
 
Hi Bong,

Thanks for correcting the code. Works great. The code splits the table into multiple tables. The only thing is that an error is generated at the end of the procedure:

RunTime Error 5
Invalid procedure call or argument

Code:
Dim eRow as Row
Dim newTable as Table
Dim i as Long

Set newTable = ActiveDocument.Tables(1)

i = 1
     Do While i > 0
         For Each eRow In newTable.Rows
           If eRow.Cells(3).Range = Chr(13) & Chr(7) Then
             i = eRow.Cells(3).RowIndex
              If i = 1 Then
                Exit Do
            [red] i = 1[/red]
         End If
      End If
  Next
newTable.Split (i)
Loop

Just wondering if the i=0 (in red) should be placed elsewhere in the loop? I have tried before and after the newTable.split statement, but still the same error. Almost there, just need to troubleshoot why the error is firing up. Any suggestions?

Thanks once again.

Geoff,

Thanks for coming back and letting me know.

Regards,
 
Yes, i=1 should follow (directly) newTable.Split (i). You were probably confused by my use of the "inline" If...Then structure: If n = 1 Then Exit Do. Note that there is no End If in this form.

_________________
Bob Rashkin
 
Hi Bong,

Thanks for the prompt reply. Changed the code to that shown below. There is a different error now:

RunTime Error 4120
Bad parameter

The offending line is newTable.Split (i)

Sorry to be a pain, but i am new to VBA and still learning.

Code:
Dim eRow as Row
Dim newTable as Table
Dim i as Long

Set newTable = ActiveDocument.Tables(1)

i = 1
     Do While i > 0
         For Each eRow In newTable.Rows
           If eRow.Cells(3).Range = Chr(13) & Chr(7) Then
             i = eRow.Cells(3).RowIndex
              If i = 1 Then Exit Do
          End If
       Next
    newTable.Split (i)
  i = 1
Loop

Regards,
 
Again, you've been fooled by my original inline If...Then.
Code:
Dim eRow as Row
Dim newTable as Table
Dim i as Long

Set newTable = ActiveDocument.Tables(1)

i = 1
     Do While i > 0
         For Each eRow In newTable.Rows
           If eRow.Cells(3).Range = Chr(13) & Chr(7) Then
             i = eRow.Cells(3).RowIndex
              [s]If i = 1 Then Exit Do[/s]
          End If
       Next
       [red]if i = 1 Then Exit Do[/red]
    newTable.Split (i)
  i = 1
Loop

Here's the logic:
1)You're going to loop until either there are no blank rows in newTable, or the first row is the only blank one. This could probably be formulated without the Exit Do but it seems unnecessary.
2)You step through all the rows of newTable setting i equal to the row number of each blank row in succession. When you get to the end of the table, i equals the highest row number of a blank row.
3)Now you're outside the For Each...Next loop (but still inside the Do While loop, and i either equals 1 or some higher number. If it's equal to 1, you're done; if not, split newTable there.
4)Now newTable is truncated and another table (Tables(2), for instance) is the bottom part of the original newTable starting with the last (highest row number) blank row.
5) Do it all again.

_________________
Bob Rashkin
 
Bong,

Many many thanks! Makes sense now and everything works beautifully.

Regards,
 
Hi Bong,

i have just tried the code on a large document with little success. I hasten to add that this isn't due to your code, just the sheer size of the document. The document is some 450 pages long with over 2000 rows which could potentially result in 100+ individual tables. Unfortunately, the document just freezes and does not seem to be running. The only reason i wanted individual tables is that other documents will be generated with data contained in the individual tables (one document per table) and thought that individual tables would be easier to select ranges of data:

.SetRange Selection.Range.Start, Selection.Range.end

I see two possible solutions: Either move to excel as a possible alternative as this is far more superior (i think) at handling large amounts of table data and query the excel spreadsheet from word or, perform a search within the word table without splitting into individual tables.

The problem with the latter solution is how to end the range. With my limited VBA experience, i am finding this difficult. Below is some sample code that may indicate what i am after.

Code:
Dim sel As String, LsnNameCellText As String, DCellText As String, VenCellText As String
Dim lsnEl As Document
Dim lsnTable As Table, lsnCell As Cell

 Set lsnEl = Documents.Open(ThisDocument.Path & "\The Big Table to search.doc")
 Set lsnTable = lsnEl.Tables(1)
    
 Application.ScreenUpdating = False
 Application.Options.Pagination = False
 
 'set sel variable to the value of the ISNo text box
  sel = Me.ISNo.Value
  
    With lsnTable.Cell(1, 2)
        .Select
        Selection.SelectColumn
        
        'exclude first header
        Selection.SetRange Start:=Selection.Cells(2).Range.Start, End:=Selection.End
                
            
                'search for IS number assigned to sel variable text
            With Selection.Find
                    .MatchWildcards = True
                    .Format = True
                    .Forward = True
                    .MatchCase = False
                    .MatchWholeWord = False
                    .MatchSoundsLike = False
                    .Execute findtext:=sel
                End With
                    
            'if the selection is found then..
            If Selection.Find.Found = True Then
                Selection.Select
                    Selection.MoveLeft wdCell, 1, wdMove
                    Selection.Select
                        LsnNameCellText = Selection.Range.Text
                    Me.LessonTitle.Value = LsnNameCellText
                    Selection.MoveRight wdCell, 4, wdMove
                        Selection.Select
                            DCellText = Selection.Range.Text
                    Me.Duration.Value = DCellText & " X 45 min"
                    
                       [red] Selection.MoveLeft wdCell, 2, wdMove
                            Selection.MoveRight wdCharacter, 2, wdExtend
                            Do While Selection.Rows(.RowIndex).Cells(3).Range.Text = Chr(13) & Chr(7)
                            Selection.MoveDown wdLine, 1, wdExtend
                            Loop
'                    Selection.MoveRight wdCell, 1, wdMove
'                        Selection.Select
'                           VenCellText = Selection.Range.Text
'                    Me.Venue.Value = VenCellText[/red]
                    
            End If
            
 End With
 
 If Selection.Find.Found = False Then
    MsgBox "No records found for this lesson title."
End If
 
 
 lsnEl.Close wdDoNotSaveChanges
 
 Application.ScreenUpdating = True
 Application.Options.Pagination = True

it is the red part of the code that causes me a headache with this alternative solution, how to end the range at the blank row. Two cells in two adjacent columns are initially selected and then I want the range to extend down to (but no including) the blank row.

each sel variable will be a unique number matching numbers within the large table.

regards,
Paul
 
As I understand your situation, your Word document has a single table over multiple (100s) pages. It does, indeed, sound like Word is the wrong application for this but, oh well.

I'd start with a more simple test. First, see if you can actually find all the blank rows in the entire table. I'd use a collection to keep the row number, but that's because I really like collections. It might go like this:
Code:
Dim sel As String, LsnNameCellText As String, DCellText As String, VenCellText As String
Dim lsnEl As Document
Dim lsnTable As Table, lsnCell As Cell
[red]dim clRws as new collection[/red]

 Set lsnEl = Documents.Open(ThisDocument.Path & "\The Big Table to search.doc")
 Set lsnTable = lsnEl.Tables(1)
    
 Application.ScreenUpdating = False
 Application.Options.Pagination = False
  [red]for each eRow in lsnTable.rows
     If eRow.Cells(3).Range = Chr(13) & Chr(7) Then
        clRws.add(eRow.cells(3).rowindex)
     End If
  Next
  msgbox("number of blank rows = " & clRws.count)[/red]
If that works, then you have a list of the blank row numbers. From there you work out the logic, probably with a For ... Next loop, for searching the table. If not, well, then I think you should consider Excel.

_________________
Bob Rashkin
 
....I'm still lurking. If you need an excel solution, please give description of how the text file looks when opened in excel and exactly what you need to do with it (I assume it will be slightly different as you'll have to create tables in Word rather than splitting 1 big table...)

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question
 
PStrongs, it could also be that you are using Selection as the vehicle. Notice that Bong's code does not.

Using Selection takes up resources that could be otherwise used. This may not make much difference on short documents, but on large ones it most certainly does. Where possible use objects, and Range of objects.

faq219-2884

Gerry
My paintings and sculpture
 
Hi Geoff,

Comforting to know that you are still there.

Excel plays a part in this process as it stands now. The BO report is opened in Excel and the user manually selects the cells to be input into the word document. Through the process of formatting the document, the users selection is pasted into the Word document (Selection.PasteExcelTable), converted into a word table and formatted accordingly. I want to get away from user intervention because of two reasons: It will make it quicker and secondly it will eliminate any risk of the user selecting an incomplete range of data.

I will look at Bongs suggestions and if I may, come back to you for further guidance should I decide to go down the Excel route.

Bong,

Thanks for your suggestion. I will give this a try and let you know the outcome.

Fumei,

Thanks as always for your valued advice. I will check to see if I am using Selection ( I think that is the case).

Thank you all for your expertise

Regards,

Paul
 
Paul - no probs - I'll keep an eye on the thread...

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question
 
Hi Guys,

Tried your code Bong and it returns the Blank row indexes, so tried the code below:

Code:
If Selection.Find.Found = True Then
                Selection.Select
                    Selection.MoveLeft wdCell, 1, wdMove
                    Selection.Select
                        LsnNameCellText = Selection.Range.Text
                    Me.LessonTitle.Value = LsnNameCellText
                    Selection.MoveRight wdCell, 4, wdMove
                        Selection.Select
                            DCellText = Selection.Range.Text
                    Me.Duration.Value = DCellText & " X 45 min"
                    Selection.MoveLeft wdCell, 2, wdMove
                    Selection.MoveRight wdCharacter, 2, wdExtend

                    [red]Set curSel = Selection.Range
                    For Each eRow In lsnTable.Rows
                        If eRow.Cells(3).Range.Text = Chr(13) & Chr(7) Then
                           rwIndex = eRow.Cells(3).RowIndex
                           MsgBox rwIndex
                           Exit For
                        End If
                    Next[/red]

This returns the row index, but unfortunately if the found text is below the first blank row, then it is useless. If there was someway of setting the loop from the found text row and then set a range from there to the next blank row, it may work.

However, due to the size of the document, it is quite slow to search for the text.

Geoff,

I have attached an Excel spreadsheet showing how the text looks when imported.

I feel that this may be the way to go if it is at all feasable. I have already written the code to format the excel table into a Word table, so I would appreciate your guidance on setting up a find/select/insert routine to populate the Word bookmarks from the Excel spreadsheet. I haven't tried uploading an attachment on this site yet, so it may go horribly wrong!

Regards,
Paul
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top