Split table into multiple tables 4

[PStrongs]

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

 

[Bong]

If you still want to pursue the Word path, I would do it with the collection of blank row numbers. Now, presumably, the row directly following a blank row has some information in one or more cells characterizing the subsequent block of data. Let's say that the row following the blank row has a title string in column n. Then having done

  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

what you do next depends on how you want to interrogate the data. Let's say you want to get some data from the block of rows where the title (in column n of the blank-following row) is "abc data". You can find the range of rows:

for i=1 to clRws.count
   i1 = clRws(i)
   if lsnTable.cell(i1+3,[i]n[/i]).range.text="abc data" then
     i2=clRws(i+1)
     exit for
   end if
next

now your data of interest lies between rows i1 and i2.

_________________
Bob Rashkin

 

[fumei]

Just as a possible alternative:

Sub SplitMyTable()
Dim aTable As Table
Dim aRow As Row
Dim j As Long
Dim var

Set aTable = ActiveDocument.Tables(1)
j = aTable.Rows.Count
For var = j To 1 Step -1
   If aTable.Rows(var).Cells(1).Range.Text = _
      Chr(13) & Chr(7) Then
      Set aRow = aTable.Rows(var + 1)
      aTable.Split aRow
      aTable.Rows(aTable.Rows.Count).Delete
   End If
Next
Set aTable = Nothing
End Sub

This moves backwards through the table, finds a row with nothing in Cell 1, splits the table.

This makes the blank row, the last row of the table, so that row is deleted, and the code moves on.

Just did a test on a table with 2040 rows, with blank rows every fourth row - so LOTS of processing. It took a little over 5 minutes.

I am sure Excel could do it in a fraction of that time, as handling rows it what it does.

faq219-2884

Gerry
My paintings and sculpture

 

[Bong]

I'm still not clear why splitting the table is useful if the OP is going to interrogate the data programmatically.

_________________
Bob Rashkin

 

[fumei]

To tell the truth, actually, I am not sure what is really going on.

The original post itself makes no mention of using Find to look for something. It had:

"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."

Your suggestion does. My suggestion does.

Plus, the searching is still using Selection, which would not be a good way to go.

Shrug.

faq219-2884

Gerry
My paintings and sculpture

 

[PStrongs]

Guys,

Thanks for the input. Bong,

I have tried your code and with my limited expertise have put together the code below.

Text is found a range is set(not sure how accurate it is) and text is returned. Unfortunately, it only returns the first complete header row of the table and not the two column range that I need. I must be doing something wrong.

Fumei,

thanks for the post and I will try your code in the morning.

I think that multiple tables will be much easier to index and also much quicker to search, although I could be wrong.

regards,
Paul

sel = Me.ISNo.Value

  [red]For Each eRow In lsnTable.Rows
        If eRow.Cells(3).Range = Chr(13) & Chr(7) Then
            rwInx.Add (eRow.Cells(3).RowIndex)
        End If
  Next[/red]
  
    With lsnTable.Cell(1, 2)
        .Select
        Selection.SelectColumn
        
        'exclude first header
        Selection.SetRange Start:=Selection.Cells(2).Range.Start, End:=Selection.End
            
                'search for x.x text
            With Selection.Find
                    .MatchWildcards = True
                    .Format = True
                    .Forward = True
                    .MatchCase = False
                    .MatchWholeWord = False
                    .MatchSoundsLike = False
                    .Execute findtext:=sel
                End With
                    
            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
                    Set curSel = Selection.Range
                   
                    [red]For i = 1 To rwInx.Count
                        i1 = rwInx.Count
                            If lsnTable.Cell(i1 + 3, 3).Range = "Item No" Then
                                i2 = rwInx(i + 1)
                                Exit For
                            End If
                    Next
                    Selection.SetRange Start:=i1, End:=i2
                    fdTble = Selection.Range.Text
                    'replace para with tab for tab delimited table conversion
                    fdTble = Replace(fdTble, Chr(13), Chr(9))
                    fdTble = Left(fdTble, Len(fdTble) - 2)
                    
                  Set rng = ThisDocument.Bookmarks("CseNameMain").Range
                  rng.InsertAfter fdTble[/red]
                    
            End If
 End With

 

[PStrongs]

Fumei you are a star!

The code works exactly as i want it to. I have tried it on a document with over 4000 rows and it took around 20 minutes. Slow admittedly, but does the job.

My perception is that the multiple tables are much easier to reference and quicker to search.

I can now use this document as a 'database' and extract the info that I need. I have also solved the range issue and can now extract the two column information.

Once I have written the code, I will paste here in case anyone else has a similar issue.

Thanks to you all (Bong, Fumei and Geoff) for your efforts in attempting to solve this problem.

Without the talents, commitment and dedication of you guys and others like you, a lot of us rookies out here would be in a real pickle.

Regards,

Paul

 

[fumei]

Whew, that is good to hear. I am still not quite in the know as to the searching part, but glad to hear the table thing is close to what you are looking for.

I will say it again (and apparently again and again and again) using Selection - especially on a massive document that you are working with - is a BAD idea.

Do not do this.

Where ever possible, use table objects, use row objects, use cell objects. They each have a Range property, and therefore a Range.Find method. Using Selection.Find (especially on a massive document) slows things down quite a bit. Moving Selection (as your code does) is a particularly poor coding route.

Just as an example:

Table with four columns.

Col1 Col2 Col3 Col4

one Four_yadda1
one Four_yadda2
one Four_Yadda3

Sub Whatever()
Dim aTable As Table
Dim aRow As Row
Dim r As Range
Set aTable = ActiveDocument.Tables(1)
Set r = aTable.Range
With r.Find
    .Text = "one"
    Do While .Execute(Forward:=True) = True
        Set aRow = r.Rows(1)
        MsgBox aRow.Cells(4)
    Loop
End With
End Sub

This would display:

Four_Yadda1; Four_Yadda2; Four_Yadda3

It uses the range of the table to do the Find; when it finds a "one" (note that this is regardless of what column it is in) it makes a row object of THAT row. From there it is straightforward to get the result of the fourth cell of that row.

No Selection. No moving of Selection.

faq219-2884

Gerry
My paintings and sculpture

 

[PStrongs]

Hi Gerry,

Thanks for coming back. Understand about using ranges now, but not sure if it would help regarding part of the search requirement (the two column data). See the attached spreadsheet and this may give you a better idea of what I was after in the first place. As I said though, thanks to your little gem of code, each individual table in the split table document will be used to generate a unique document. So if there are 150 split tables, then there will be 150 individual documents generated from the search criteria.

The reason I am using this method is because the raw data is stored in an Oracle database and unfortunately my SQL/Word VBA skills would not be good enough to tackle writing SQL statements and retrieving the date that way. So the data is extracted using a Business Objects report and saved as a text file. The resultant split table document acts like a virtual database.

Probably very inefficient, but it does the job.

I will try to re-code the search using ranges instead of selections. Is there any way of selecting the two column part of the found data using a range object and retaining the table cells to make it easier to format as a table in the calling document? Currently I am using Selection.Copy/Selection.Paste as this is exactly what it does, retains the text in the cells.

Regards,

Paul