Retrieving all instances of text in a column

[Pam Cheek]

I have a table which has been sorted by office symbols,
in column 1 and then by name in column 2.

I have created a user form that allows me to utilize a
combo box to select any given row in the table. I then
have the column information printed in text boxes. This
works for individual rows.

What I need is to have all individuals with the same
office symbol appear in the text box when the office
symbol is selected.

Is there a way to do this?

Code follows:

In the User Form Initialize event:

Private Sub UserForm_Initialize()


Dim MyArrayName() As String
Dim MyArrayOffice() As String
Dim MyArrayProject() As String

RowCount = ActiveDocument.Tables(1).Rows.Count
ColCount = ActiveDocument.Tables(1).Columns.Count
ReDim MyArrayName(RowCount - 1, ColCount - 1)
For i = 1 To RowCount
For j = 1 To ColCount
'Select each cell in the table
Celldata = ActiveDocument.Tables(1).Cell(i, j)
'Remove the paragraph and end-of-cell markers
'as we load the array

MyArrayName(i - 1, j - 1) = Left(Celldata, Len
(Celldata) - 2)
Next
Next
cboSelectResourceName.ColumnCount = ColCount
cboSelectResourceName.List() = MyArrayName()

In a private sub

Private Sub cboSelectResourceName_Change()

Dim MatchFound As String

For x = 0 To cboSelectResourceName.ColumnCount

If cboSelectResourceName.MatchFound = True Then
txtSelectResourceOffice.Text =
cboSelectResourceName.Column(1)
txtSelectResourceProject.Text =
cboSelectResourceName.Column(2)
End If
Next x


End Sub

As I said, it populates the text boxes with just one row
of information, I need all rows that have the same office
symbol.

Thanks for your help.

 

[Jean-Guy Marcil]

Hi Pam,

Instead of using multi line textboxes, would you consider using list boxes
to display the found matches?
If so, here is the code to replace the private procedure you posted:
For my example I use a 3-column table, each column corresponding to a
listbox:

'_______________________________________
Private Sub cboSelectResourceName_Change()

Dim MatchFound As String
Dim x As Long

MatchFound = cboSelectResourceName.Value

lstSelectResourceOffice.Clear
lstSelectResourceProject.Clear
lstSelectResourceSurname.Clear

For x = 1 To cboSelectResourceName.ListCount
If cboSelectResourceName.List(x - 1, 0) = _
MatchFound Then
lstSelectResourceOffice.AddItem _
cboSelectResourceName.List(x - 1, 0)
lstSelectResourceProject.AddItem _
cboSelectResourceName.List(x - 1, 1)
lstSelectResourceSurname.AddItem _
cboSelectResourceName.List(x - 1, 2)
End If
Next x

End Sub
'_______________________________________

or, you might want to use a single listbox to display all records:

'_______________________________________
Private Sub cboSelectResourceName_Change()

Dim MatchFound As String
Dim x As Long
Dim y As Long
Dim FoundData() As Variant

ReDim FoundData(2, ActiveDocument.Tables(1).Rows.Count)

MatchFound = cboSelectResourceName.Value

ListBox1.Clear
y = 0

For x = 1 To cboSelectResourceName.ListCount
If cboSelectResourceName.List(x - 1, 0) = _
MatchFound Then
FoundData(0, y) = _
cboSelectResourceName.List(x - 1, 0)
FoundData(1, y) = _
cboSelectResourceName.List(x - 1, 1)
FoundData(2, y) = _
cboSelectResourceName.List(x - 1, 2)
y = y + 1
End If
Next x
ReDim Preserve FoundData(2, y - 1)
ListBox1.ColumnCount = 3
'use the Column property to transpose the data
'from (3 rows by x columns) to (3 columns to x rows)
'because ReDim Preserve can only work on the last dimension
'of the array
ListBox1.Column() = FoundData()

End Sub
'_______________________________________

--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org

 

[Pam Cheek]

Thanks Jean-Guy

I hadn't considered a list box, but it makes sense to
me. I appreciate the code assistance.

PAM