Excel VBA: Coding issues for Looping and Adding rows with Titles

[llenza]

Note: The original document is in Word all cell are tables except titles, which are listed two rows above the table (just so you know where everything is place). User Case ID is always the same size (cols and rows) and the Basic Flow varies in size - same cols, but it can have less or more rows. That is why it was best to have VBA recordnize tables and pull them from MS Word 2007.

User Case ID 1: New Client

Overview	ColB, Row3
Pre Cond	ColB, Row4
Post Cond	ColB, Row5
Assumptions	ColB, Row6
Requirements	ColB, Row7
Actors	ColB, Row8

<tbody>
</tbody>

Basic Flow:

Step	Desc	Actor	Comments	Screen
1	ColB, Row12	ColC, Row12	ColD, Row12	ColE, Row12
2	ColB, Row	ColC, Row	ColD, Row	ColE, Row
3	ColB, Row	ColC, Row	ColD, Row	ColE, Row
4	ColB, Row	ColC, Row	ColD, Row	ColE, Row
5	ColB, Row	ColC, Row	ColD, Row	ColE, Row

<tbody>
</tbody>

User Case ID 2: Old Client

Overview	ColB, Row19
Pre Cond	ColB, Row20
Post Cond	ColB, Row21
Assumptions	ColB, Row22
Requirements	ColB, Row23
Actors	ColB, Row24

<tbody>
</tbody>

Basic Flow:

Step	Desc	Actor	Comments	Screen
1	ColB, Row30	ColC, Row30	ColD, Row30	ColE, Row30
2	ColB, Row	ColC, Row	ColD, Row	ColE, Row
3	ColB, Row	ColC, Row	ColD, Row	ColE, Row

<tbody>
</tbody>

User Case ID 3: Existing Client

Overview	ColB, Row40
Pre Cond	ColB, Row41
Post Cond	ColB, Row42
Assumptions	ColB, Row43
Requirements	ColB, Row44
Actors	ColB, Row45

<tbody>
</tbody>

Basic Flow:

Step	Desc	Actor	Comments	Screen
1	ColB, Row51	ColC, Row51	ColD, Row51	ColE, Row51
2	ColB, Row	ColC, Row	ColD, Row	ColE, Row
3	ColB, Row	ColC, Row	ColD, Row	ColE, Row
4	ColB, Row	ColC, Row	ColD, Row	ColE, Row
5	ColB, Row	ColC, Row	ColD, Row	ColE, Row
6	ColB, Row	ColC, Row	ColD, Row	ColE, Row

<tbody>
</tbody>

My MS Word 2007 doc has 133 tables, which need to get transferred into Excel. I have borrowed parts and pieces of VBA code to pull from Word these tables and copy them to Excel. Unfortunately, it only copies one (this is the main problem). I have tried including a Loop, but guess I am placing it in the wrong order or place.

VBA Code:
1. VBA ask on which Word document to perform the operation (Word Open menu appears)
2. Then it Counts how many tables the document contains in my case it's 133 in the example provided above it should say SIX (3 Use Cases/3 Basic Flows).
3. It asks, which table do I want to copy over (it only pull one at a time)

All the code above works fine! (Steps 1 - 3)

Wish list (what I have been trying to get it to do with 2 weeks now):
1. I want for it to pull all the table from where I tell it to START
2. Add the Use Case and Basic Flow titles to Excel (located two rows above the tables in Word)

Issues:
1. Can’t write the code for looping from Start Number to Finish (133rd table)
2. Can’t add rows to include Titles ready appearing on Word or adding them to the VBA code

VBA Codes:

Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As integer ‘table number in Word
Dim iRow As integer ‘row index in Excel
Dim iCol As integer ‘row index in Excel
Dim Counter As integer ‘row index in Excel
Dim myNum As integer ‘row index in Excel

WdFileName = Application.GetOpenFilename(“Word files (*.docx,*docx, , _”Browse for file containing table to be imported”)

If wdFileName = False Then Exit Sub ‘(user cancelled import file browser)

Set wdDoc = GetObject(wdFileName) ‘open Word file
With wdDoc
TableNo = wdDoc.tables.Count
If TableNo = 1 Then
MsgBox “This document contains no tables”, vbExclamation, “Import Word Table”

ElseIf TableNo > 1 Then
TableNo = InputBox (“This Word document contains “ & TableNo & “tables.” & vbCrLf & _”Enter table number from where to begin table import”, “Import Word Table”, “1”)

End If
With .tables(TableNo)

‘copy cell contents from Word table cells to Excel cells
For iRow = 1 To .Rows.Count
For iCol = 1 To .Columns.Count
Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
Next iCol
Next iRow

End With

End With

Set wdDoc = Nothing

End Sub

 

[AlphaFrog]

Try something like this...

    [color=darkblue]With[/color] wdDoc
        TableNo = wdDoc.Tables.Count
        [color=darkblue]If[/color] TableNo = 1 [color=darkblue]Then[/color]
            MsgBox "This document contains no tables", vbExclamation, "Import Word Table"
            
        [color=darkblue]ElseIf[/color] TableNo > 1 [color=darkblue]Then[/color]
            TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _
                               "Enter table number from where to begin table import", "Import Word Table", "1")
            
            [color=darkblue]If[/color] TableNo = 0 [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]    [color=green]'User canceled[/color]
        
            [color=darkblue]For[/color] i = TableNo [color=darkblue]To[/color] wdDoc.Tables.Count   [color=green]'Loop through tables[/color]
            
                [color=green]'Copy previous Senetnce[/color]
                [color=darkblue]With[/color] .Tables(i).Range.GoToPrevious(3)
                    .Expand 3
                    .Copy
                [color=darkblue]End[/color] [color=darkblue]With[/color]
                ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
                
                [color=green]'Copy Table[/color]
                .Tables(i).Range.Copy
                ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
                
            [color=darkblue]Next[/color] i
            
        [color=darkblue]End[/color] [color=darkblue]If[/color]
        
    [color=darkblue]End[/color] [color=darkblue]With[/color]

 

[llenza]

Thank you AlphaFrog,

JUST ONE CLICHE AND ONE WISH LEFT IF YOU CAN HELP!

It works! I added more lines of code now it ask at what table to I wish to end up with at the end. Once it worked I realized it was pulling tables I did not care for towards the end. I just have one cliche and that is when one cell has multiple line in Word upon pasting to Excel it places the subsequent lines of text in individual cells. In addition to that instead of pasting them in Column B where they originated from in Word it copies them to Column A in Excel.

Extra is there a way that it copies the format as well when it copies. The Word doc has title cells in gray, Table titles are bold and each table in word as visible line around the table box, but in Excel all of the formating is removed. Can I change the special paste to just paste format and all?

By the way a million thanks again!

 

[AlphaFrog]

    [color=darkblue]With[/color] wdDoc
    
        TableNo = .Tables.Count
        
        [color=darkblue]If[/color] TableNo <= 1 [color=darkblue]Then[/color]
            MsgBox "This document contains no tables", vbExclamation, "Import Word Table"
            
        [color=darkblue]Else[/color]
            
            [color=darkblue]Do[/color]
            TableStart = Application.InputBox("This Word document contains " & TableNo & " tables." & vbCr & vbCr & _
                         "Enter the table number to begin import. ", "Import Word Tables: Start", 1, Type:=1)
                         [color=darkblue]If[/color] TableStart = 0 [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]     [color=green]'User canceled[/color]
                         [color=darkblue]If[/color] TableStart <= 0 [color=darkblue]Or[/color] TableStart > TableNo [color=darkblue]Then[/color]
                            MsgBox "Enter a value from 1 to " & TableNo & ". ", vbExclamation, "Invalid Entry"
                         [color=darkblue]End[/color] [color=darkblue]If[/color]
            [color=darkblue]Loop[/color] [color=darkblue]Until[/color] TableStart > 0 And TableStart <= TableNo
                         
            [color=darkblue]Do[/color]
            TableEnd = Application.InputBox("This Word document contains " & TableNo & " tables." & vbCr & vbCr & _
                       "Enter the table number to end import. " & vbCr & vbCr & _
                       "Enter a value between " & TableStart & " and " & TableNo & ". ", "Import Word Tables: End", TableNo, Type:=1)
                       [color=darkblue]If[/color] TableEnd = 0 [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]     [color=green]'User canceled[/color]
                       [color=darkblue]If[/color] TableEnd < TableStart [color=darkblue]Or[/color] Table[color=darkblue]End[/color] > TableNo [color=darkblue]Then[/color]
                          MsgBox "Enter a value from " & TableStart & " to " & TableNo & ". ", vbExclamation, "Invalid Entry"
                       End [color=darkblue]If[/color]
            [color=darkblue]Loop[/color] [color=darkblue]Until[/color] TableEnd >= TableStart And Table[color=darkblue]End[/color] <= TableNo
        
            Application.ScreenUpdating = [color=darkblue]False[/color]
            [color=darkblue]For[/color] i = TableStart [color=darkblue]To[/color] TableEnd   [color=green]'Loop through tables[/color]
            
                [color=green]'Copy previous Senetnce[/color]
                [color=darkblue]With[/color] .Tables(i).Range.GoToPrevious(3)
                    .Expand 3
                    .Copy
                [color=darkblue]End[/color] [color=darkblue]With[/color]
                ActiveSheet.Range("B" & Rows.Count).End(xlUp).Offset(1).Select
                ActiveSheet.Paste
                
                [color=green]'Copy Table[/color]
                [color=darkblue]With[/color] .Tables(i).Range.Find
                [color=green]'Temporarily replace line feeds within table cells[/color]
                    .Text = "^p"
                    .Replacement.Text = "||"
                    .Forward = [color=darkblue]True[/color]
                    .Wrap = 0
                    .Format = [color=darkblue]False[/color]
                    .MatchCase = [color=darkblue]False[/color]
                    .MatchWholeWord = [color=darkblue]False[/color]
                    .MatchWildcards = [color=darkblue]False[/color]
                    .MatchSoundsLike = [color=darkblue]False[/color]
                    .MatchAllWordForms = [color=darkblue]False[/color]
                    .Execute Replace:=2
                .Parent.Copy
                    .Text = "||"
                    .Replacement.Text = "^p"
                    .Execute Replace:=2
                [color=darkblue]End[/color] [color=darkblue]With[/color]
                
                ActiveSheet.Range("B" & Rows.Count).[color=darkblue]End[/color](xlUp).Offset(1).Select
                ActiveSheet.Paste
                ActiveSheet.Cells.Replace "||", Chr(10) [color=green]' Replace line feeds in pasted table[/color]
                
            [color=darkblue]Next[/color] i
            Application.ScreenUpdating = [color=darkblue]True[/color]
        End [color=darkblue]If[/color]
        
    End [color=darkblue]With[/color]

 

[llenza]

AlphaFrog,

The script run for one table only. It copies the first table from word and place in Excel with borders around cell. Looks great, but then it error out in the code where it indicationed (ActiveSheet.Paste) and that where it stops. I tried changing the code, but not thing works not sure what to do. i just want to take this opportunity to let you know how much I appreciate your help. I am learning believe it or not.

Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim myNum As Integer 'table number in Word

wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _
"Browse for file containing table to be imported")

If wdFileName = False Then Exit Sub '(user cancelled import file browser)

Set wdDoc = GetObject(wdFileName) 'open Word file

With wdDoc
TableNo = wdDoc.Tables.Count
If TableNo = 1 Then
MsgBox "This document contains no tables", vbExclamation, "Import Word Table"

ElseIf TableNo > 1 Then
TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _
"Enter table number from where to begin table import", "Import Word Table", "1")
myNum = InputBox("This Word document contains " & myNum & " tables." & vbCrLf & _
"Enter table number from where to end table import", "Import Word Table", "123")

If TableNo = 0 Then Exit Sub 'User canceled

If myNum = myNum + 1 Then Exit Sub 'User canceled

For i = TableNo To myNum 'Loop through tables

'Copy previous Sentence
With .Tables(i).Range.GoToPrevious(3)
.Expand 3
.Copy
End With
ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(2).Select
ActiveSheet.Paste

'Copy Table
With .Tables(i).Range.Find
'Temporarily replace line feeds within table cells
.Text = "^p"
.Replacement.Text = "||"
.Forward = True
.Wrap = 0
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2
.Parent.Copy
.Text = "||"
.Replacement.Text = "^p"
.Execute Replace:=2
End With

ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
ActiveSheet.Cells.Replace "||", Chr(10) ' Replace line feeds in pasted table

Next i
Application.ScreenUpdating = True
End If

End With

End Sub