Add rows to word table from userform code

[tbransco]

Hello,

I want to use code located in a userform to add a blank row to a table in my document, but Word refuses to cooperate, informing me that some or all of the selection (?) is not within the table (runtime error 4605). Makes me think table cannot be manipulated from within a userform. Anyway, there is a single table in my document (generated from a template) which starts with two rows each time the document is generated from an underlying template.

The userform code is located within a command button Click event handler:

Private Sub cmdAdd_Click()

    Dim intLastRow              As Integer
    Dim objTable                As Word.Table
    
    ' if there is data in the first column of the last row, add a new row to the table
    Set objTable = ActiveDocument.Tables(1)
    With objTable
        intLastRow = .Rows.Count
        If Len(.Cell(intLastRow, 0).Range.Text) > 0 Then
            .Rows.Add                   <-----------------  Error 4605 triggered
        End If
    End With
    Set objTable = Nothing

If anyone can guide me to the appropraite syntax, i'd sure appreciate it!

Thanks,
Terry

[fumei]

I copied your code exactly. I get no error.

Comments:

As written the code ALWAYS makes a new row regardless of the content of the cell. Text or no text, the code always makes a new row. This because


Len(.Cell(intLastRow, 0).Range.Text)

is always greater than zero. Len of a blank cell.range.text always = 2. The range of a cell includes the end-of-cell marker, a unique two character object consisting of ASCII 13 (carriage return) and ASCII 7 (bell) - the sound typewriters made when they did a carriage return.

[tbransco]

Thanks, fumei.

Good to know about the end-of-cell marker contents. I'll adjust my checks for empty cells accordingly, and retry my code in a new document to eliminate any interference from other code bits in my project.

Kind of you to respond!
Terry

[tbransco]

Hmm.

I seem to be left with the same Error 4605 in my original document, despite the fact I too verified the identical code does work when its copied to another document. I just can't see what a 'selection' has to do with it since I don't have anything selected in the document.

Terry

[fumei]

Impossible for us to say. Unless of course you post your full code, or a document file that shows the behaviour.

[tbransco]

OK, thanks again for sticking with me!

My userform code follows, and it's called by a macro in a standard module that's configured as a formfield OnExit macro.

Option Explicit
Private mavarWellData               As Variant
Private mintFoundWells              As Integer
Private mbooEntryError              As Boolean

Private Sub UserForm_Initialize()
    Me.SetDefaultTabOrder
    ' When this userform is activated from within the document, set the Title textbox to the value in the document's TitleNum formfield;
    ' otherwise, leave the Title textbox blank
    If Len(Trim(ActiveDocument.FormFields("FileNum").Result)) > 0 Then
        Me.txbTitle.Text = Trim(ActiveDocument.FormFields("FileNum").Result)
    End If
    Me.cmdAdd.Enabled = False
End Sub 'UserForm_Initialize

Private Sub cmdCancel_Click()
' click on the CANCEL button to close the form
        
    Me.txbTitle.Text = ""
    Me.txbCancDt.Text = ""
    Me.lisWells.Clear
    Unload Me
End Sub 'cmdCancel_Click

Private Sub txbTitle_Enter()
    With txbTitle
        .SelStart = 0
        .SelLength = Len(.Text)
    End With
End Sub 'txbTitle_Enter

Private Sub txbTitle_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
' retrieve and display the cancellation date and any associated wells remaining on title for the cancelled titles
    Dim strTitle                As String
    Dim strSQL                  As String
    
    mbooEntryError = False
    
    If Len(Trim(Me.txbTitle.Text)) = 0 Then
        Beep
        mbooEntryError = True
        MsgBox "Please enter a title number, or click Cancel to finish.", vbInformation
    End If
    
    If Not IsNumeric(Me.txbTitle.Text) Then
        Beep
        mbooEntryError = True
        MsgBox "Invalid title number format.  Please enter integers only.", vbInformation, "Invalid title number"
    End If
End Sub 'txbTitle_BeforeUpdate

Private Sub txbTitle_Exit(ByVal Cancel As MSForms.ReturnBoolean)
' Retrieve and display the title and well information based on the input title
    Dim i                   As Integer
    Dim strSQL              As String
    Dim strList             As String
    Dim strTitle            As String
    Dim strCancelDate       As String
    
    'If the title value is invalid, stop everything
    If mbooEntryError Then Exit Sub
    
    ' Retrieve the title cancellation date and update the userform directly
    strTitle = Me.txbTitle.Text
    If Not IsCancelled(strTitle) Then
        MsgBox "Sorry, that's not a cancelled title.  Please try again.", vbInformation
        Exit Sub
    End If
    With Me.cmdAdd
        .Enabled = True
        .SetFocus
    End With
    strCancelDate = Format(GetCancelDate(strTitle), "yyyy-mmm-d")
    Me.txbCancDt.Text = strCancelDate
    
    ' Retrieve any well permits associated with this well, and store them in an array
    Set grstIPS = New adodb.Recordset
    strSQL = "SELECT T1.WA_NUMBER FROM IPS.IPS_TITLE_WELL T1 " & _
            " WHERE T1.TITLE_NUMBER_ID = " & strTitle
    
    grstIPS.Open _
        Source:=strSQL, _
        ActiveConnection:=gcnnIPS, _
        CursorType:=adOpenStatic, _
        LockType:=adLockReadOnly
   
    If grstIPS.RecordCount = 0 Then ' if there are no wells found
        Beep
        GoTo CleanUp
    End If
    mintFoundWells = grstIPS.RecordCount
    
    ReDim mavarWellData(grstIPS.RecordCount - 1, 1) As Variant
    With grstIPS
    .MoveFirst
    For i = LBound(mavarWellData) To UBound(mavarWellData)
        mavarWellData(i, 0) = grstIPS.Fields(0).Value
        strList = strList & Chr(39) & mavarWellData(i, 0) & Chr(39)
        If i < UBound(mavarWellData) Then
            strList = strList & ","
        End If
        .MoveNext
    Next i
    End With
    
    Set grstIPS = Nothing
        
    ' Retrieve the well name of these same wells
    Set grstIPS = New adodb.Recordset
    strSQL = "SELECT W1.WELL_NAME " & _
             "  FROM IPS.IPS_WELL_MVW W1 " & _
             " WHERE W1.WA_NUMBER IN (" & strList & ")"
    
    grstIPS.Open _
        Source:=strSQL, _
        ActiveConnection:=gcnnIPS, _
        CursorType:=adOpenStatic, _
        LockType:=adLockReadOnly
   
    If grstIPS.RecordCount = 0 Or IsNull(grstIPS.Fields(0).Value) Then
        Beep
        MsgBox "Cannot retrieve wellnames from IPS_WELL_MVW", vbCritical, "ERROR"
        GoTo CleanUp
    End If
    
    ReDim Preserve mavarWellData(mintFoundWells - 1, 1) As Variant
    With grstIPS
    .MoveFirst
    For i = 0 To mintFoundWells - 1
        mavarWellData(i, 1) = grstIPS.Fields(0).Value
        .MoveNext
    Next i
    End With
    
    ' Display the well data
    Me.lisWells.List = mavarWellData
CleanUp:
   grstIPS.Clone
   Set grstIPS = Nothing
    
End Sub 'txbTitle_AfterUpdate
Private Sub cmdAdd_Click()
' click the [Add Title to Letter] button to accept this well and add it to the letter
    Dim i                       As Integer
    Dim intLastRow              As Integer
    Dim objTable                As Word.Table
    Dim strWellData             As String
    
     ' if there is data in the first column of the last row, add a new row to the table
    Set objTable = ActiveDocument.Tables(1)
    With objTable
        intLastRow = .Rows.Count
        If Len(Trim(.Cell(intLastRow, 0).Range.Text)) - 2 > 0 Then    ' end-of-cell marker
            .Rows.Add                   '<-----------------  Error 4605 triggered
        End If
    End With
    Set objTable = Nothing
    
    Call UnlockDoc
    ActiveDocument.Tables(1).Cell(intLastRow, 1).Range.Text = Me.txbTitle.Text
    ' Insert the cancellation date
    ActiveDocument.Tables(1).Cell(intLastRow + 1, 2).Range.Text = Me.txbCancDt
    If mintFoundWells > 0 Then
        'Insert the well permit number and wellname
        For i = LBound(mavarWellData) To UBound(mavarWellData)
            strWellData = strWellData & "WA " & mavarWellData(i, 0) & Space(10) & mavarWellData(i, 1) & vbCr
        Next i
        ActiveDocument.Tables(1).Cell(intLastRow, 3).Range.Text = strWellData
    End If
    Call LockDoc
        
    Me.txbTitle.Text = ""
    Me.txbCancDt.Text = ""
    Me.lisWells.Clear
    Me.cmdCancel.SetFocus
End Sub 'cmbAdd_Click

[fumei]

formfield OnExit macro

Then the Selection is still there...outside the table I assume, although you do not state this. WHERE is the formfield?

[tbransco]

Thanks, fumei.

Yes, that's correct. The formfield is in the body of the document template, and the table is further down the page. I did think of moving the selection into the table, but was not successful in my attempts to do so from the userform, or the problem was not precisely as the error message describes it. I've removed my trial code, but I believe I tried this:

ActiveDocument.Tables(1).Cells(0,0).Range.Select.Collapse

Terry

[tbransco]

fumei,

I want to thank you again for leading me by the nose to the solution: moving the insertion point to the table BEFORE calling the userform.

Cheers,

Terry

[fumei]

And there you go.