Macro that generates a prompt box(?) that once selected inserts da

[Russ]

Will this change work for you?

Private Sub CommandButton1_Click()
Dim i As Long
Dim j As Long
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
For j = 1 To ListBox1.ColumnCount
ListBox1.BoundColumn = j
If j < ListBox1.ColumnCount Then
Client = Client & ListBox1.List(i).Value & vbTab
Else
Client = Client & ListBox1.List(i).Value & vbCr
End If
Next j
End If
Next i
Set oRng = ActiveDocument.Bookmarks("Client").Range
oRng.Text = Client
ActiveDocument.Bookmarks.Add "Client", oRng
Me.Hide
End Sub
'=======================

'Here are the functions Replace(), Split(), Join(), and InStrRev()
'equivalents so that your Word97 can run code, with the newer functions that
'were built into later versions of Word. You should be able to copy and
'paste them all into your main code module.
'=======================

Function Replace(Source As String, Find As String, ReplaceStr As String, _
Optional ByVal Start As Long = 1, Optional Count As Long = -1, _
Optional Compare As Integer = vbTextCompare) As String
'vbBinaryCompare is for matching case
Dim findLen As Long
Dim replaceLen As Long
Dim Index As Long
Dim counter As Long

findLen = Len(Find)
replaceLen = Len(ReplaceStr)
' this prevents an endless loop
If findLen = 0 Then Err.Raise 5

If Start < 1 Then Start = 1
Index = Start

' let's start by assigning the source to the result
Replace = Source

' if Find and ReplaceStr strings have same length, it is possible to
' use an optimized algorithm, based on the Mid$ command
Do
Index = InStr(Index, Replace, Find, Compare)
If Index = 0 Then Exit Do
If findLen = replaceLen Then
' if the find and replace strings have same length
' we can use the faster Mid$ command
Mid$(Replace, Index, findLen) = ReplaceStr
Else
' else we must use concatenation
Replace = Left$(Replace, Index - 1) & ReplaceStr & Mid$(Replace, _
Index + findLen)
End If
' skip over the string just added
Index = Index + replaceLen
' increment the replacement counter
counter = counter + 1
' Note that the Loop Until test will always fail if Count = -1
Loop Until counter = Count

' The next operation serves to keep complete compatibility with
' VB6's Replace function. You can delete it if you prefer.
If Start > 1 Then Replace = Mid$(Replace, Start)

End Function
'=================

Public Function Split(ByVal sString As String, sDelimiter As String,
Optional iCompare As Integer = vbBinaryCompare) As Variant
'use vbTextCompare to match caseless
Dim sArray() As String, iArrayUpper As Integer, iPosition As Integer
iArrayUpper = 0
iPosition = InStr(1, sString, sDelimiter, iCompare)
Do While iPosition > 0
ReDim Preserve sArray(iArrayUpper)
sArray(iArrayUpper) = Left$(sString, iPosition - 1)
sString = Right$(sString, Len(sString) - iPosition)
iPosition = InStr(1, sString, sDelimiter, iCompare)
iArrayUpper = iArrayUpper + 1
Loop
ReDim Preserve sArray(iArrayUpper)
sArray(iArrayUpper) = sString
Split = sArray
End Function
'=================

Function InStrRev(ByVal Text As String, Search As String, _
Optional ByVal Start As Long = -1, Optional ByVal CompareMethod =
vbBinaryCompare) As Long
Dim Index As Long
'finds position of last occurrence of Search text in String
'Start number is used to start from reverse end
'Result is position from left however
' reverse the source strings,
' so that we can use regular InStr
Text = StrReverse(Text)
Search = StrReverse(Search)
' we must "reverse" Start too
If Start < 0 Then
Start = 1
Else
Start = Len(Text) + 1 - Start
End If

Index = InStr(Start, Text, Search, CompareMethod)
If Index Then
' adjust the result
InStrRev = Len(Text) - Index - Len(Search) + 2
End If
End Function
'=================

Public Function Join(sArray() As String, Optional _
Delimiter As String = " ") As String

Dim sAns As String
Dim lCtr As Long
Dim lStart As Long
Dim lEnd As Long

lStart = LBound(sArray)
lEnd = UBound(sArray)

For lCtr = lStart To lEnd
sAns = sAns & sArray(lCtr)
If lCtr < lEnd Then sAns = sAns & Delimiter
Next

Join = sAns


End Function
'=================