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