Populate Listbox

[gmaxey]

Word (all versions). Demonstration document attached.

I have a long table that contains a single word or phrase in the cells of the first column. Additionally some of the first column cells will be blank. When this document opens I want to display a userform listbox that lists the data in the first column of my table alphabetically. When the user clicks on an entry in the listbox it will goto and select that entry in the table.

I have an Document_Open procedure that displays the following a form. The form code is as follows:

Option Explicit
Private Sub ListBox1_Click()
ActiveDocument.Tables(1).Cell(Me.ListBox1.Column(1), 1).Select
Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim oTbl As Word.Table
Dim oRng As Word.Range
Dim oRngEntry As Word.Range
Dim arrSpan() As String
Dim i As Long
Dim j As Long, x As Long
Set oTbl = ActiveDocument.Tables(1)
With Me.ListBox1
.ColumnCount = 2
.ColumnWidths = "100;0"
End With
j = 0
ReDim arrSpan(oTbl.Rows.Count, 1)
For i = 1 To oTbl.Rows.Count
Set oRng = oTbl.Cell(i, 1).Range
If Len(oRng.Text) > 2 Then
Set oRngEntry = oRng.Paragraphs(1).Range
If Len(oRngEntry) > 2 Then
arrSpan(j, 0) = Left(oRngEntry.Text, Len(oRngEntry.Text) - 2)
arrSpan(j, 1) = i
j = j + 1
End If
End If
Next i
WordBasic.SortArray arrSpan()
Me.ListBox1.List = arrSpan()
For x = Me.ListBox1.ListCount To 0 Step -1
If Me.ListBox1.List(x, 0) = "" Then
Me.ListBox1.RemoveItem x
End If
Next
On Error GoTo 0
End Sub


You will notice that I first place the content of cells containing text in an array, sort the array, and then populate the listbox with the .List method.

Since the array is dimesioned with the count of rows, there can be several elements with no data. When the array is sorted these elements appear a the end of the beginning of the array and therefore again at the beginning of the Listbox. I am using .RemoveItem to remove these "empty" entries from the listbox.

Is there some way that I could keep from populating these "empty" elements in the first place>

Secondly in the example document you will notice "L" is listed twice. When the first "L" is clicked the second is selected in the table. If the second "L" is clicked then the first "L" in the table is selected.

How can I revise the sort so that if the first "L" is selected in the listbox the first "L" in the table is selected.

Thanks.

[Tinbendr]

It is known that SortArray does not sort properly.

Is this your problem? don't know, but you could replace it with a shell sort and see.

Another thought is, can you sort more than one column? Use column 2 as the tie break.


Is there some way that I could keep from populating these "empty" elements in the first place?
Aren't you doing that already?
If Len(oRngEntry) > 2 Then

J only contailns eleven elements. Am I missing something?

[gmaxey]

Poor wording.

arrSpan has elements ReDim arrSpan(oTbl.Rows.Count, 1) and it is true that I am only writing data into eleven spots. However, when the array is sorted and then the listbox populated the "empty" elements would appear as the first entries in the listbox (if I didn't subsequently remove them).

I know that if I had only a one dimensional array that I could redim preserve arrspan with each uptick of j. This way arrspan would have the same number of elements as j.

Maybe what I am really looking for is a way to strip empty elements from the array before populating the listbox. I suppose that either way is really transparent to the end user, but it just seems like the thing do do.

I take a look a some other sort methods.

Thanks.

[Tinbendr]

I was going to suggest ReDim Preserve after the If, but you can't ReDim Preserve the first element (http://www.vbaexpress.com/forum/showthread.php?t=8581)of a multidimensional array. (But you can the second. Seems backwards.)

You could always assign the list to a DIFFERENT array, then the If you catch only the valid elements.

You could AddItem to the list inside the If, but then you'd have to sort the list. (Listbox and Combo lists really need a built in sort!)

David

[gmaxey]

Listbox and Combo lists really need a built in sort!

Yes they do.

Thanks for your interest and suggestions.

[fumei]

I get an opening error: "Invalid property array index."

Will see if I can wriggle inside.

[fumei]

Why are you doing a multidimensional listbox?

[fumei]

"Is there some way that I could keep from populating these "empty" elements in the first place>"

Yes.
Option Explicit
Private Sub ListBox1_Click()
ActiveDocument.Tables(1).Cell(Me.ListBox1.Column(1), 1).Select
Unload Me
End Sub
Private Sub UserForm_Initialize()
With Me.ListBox1
.ColumnCount = 2
.ColumnWidths = "100;0"
End With
Call FillArray

End Sub

Sub FillArray()
Dim oTbl As Word.Table
Dim oRngEntry As Word.Range
Dim arrSpan() As String
Dim strCelltext As String
Dim i As Long
Dim j As Long, x As Long
Set oTbl = ActiveDocument.Tables(1)

ReDim arrSpan(NotEmptyCell, 1)
For i = 1 To oTbl.Rows.Count
strCelltext = CellText(oTbl.Cell(i, 1).Range)
If strCelltext <> "" Then
arrSpan(j, 0) = strCelltext
arrSpan(j, 1) = i
j = j + 1
End If

Next i
WordBasic.SortArray arrSpan()
Me.ListBox1.List = arrSpan()
End Sub

Function NotEmptyCell() As Long
Dim oTbl As Word.Table
Dim i As Long
Dim strCelltext As String
Set oTbl = ActiveDocument.Tables(1)

For i = 1 To oTbl.Rows.Count
strCelltext = CellText(oTbl.Cell(i, 1).Range)
If strCelltext <> "" Then
NotEmptyCell = NotEmptyCell + 1
End If
Next
End Function
In a standard module:
Function CellText(r As Range) As String
CellText = Left(r.Text, Len(r.Text) - 2)
End Function


Still trying to fix the "L" issue.

[fumei]

The "L" issue is hard. The first "L" has a ListCount of 11, the second has a ListCount of 10. Thus the reversal of row selection. This stems from the sort (although I am not understanding how precisely).

I have not a clue how to fix this.

[gmaxey]

Gerry,

I may not need to. If not then that is just a tree that I haven't seen for the forrest.:dunno

I think I am doing it so the second "hidden" column will hold the table row number of the text shown in the first column. What I am actually doing is work on a glossary (see attached). Thanks for the other piece of code.

Greg

[fumei]

Yeah, the why multidimensional was a dumb question. I actually LOOKED at it, and it was obvious why.

Oh and of course you can get rid of:

Dim oRngEntry As Word.Range

as it is not needed for my example.

That ListCount= 10 and 11 (for the "L") though is really bugging me.

BTW: I find the structural concept for your userform very interesting, and it works extremely well. Kudos. An excellent navigation tool for the user. Although....no Cancel or Done button? Bad dog.

Not really in that if you select an action, yes, it performs the action and exits. However, what if you:

- wanted to go X, add a row...AND then go someplace else - to add a different row?

You would have to call up the userform twice, as adding a row exits the userform. It does not not give you a chance to perform multiple actions. Perhaps change it to "Add a row and Edit?"

Or is there an assumption you will only ever add one row, and then edit it immediately? You would never add more than one row?

If so...then please ignore my comment.

[gmaxey]

Gerry,

Thanks for the comments. Yes, the chap paying for the work is thrilled with the ability to easily and quickly navigate his glossary. Of course the English and Spanish (and not always the Spanish) complicated matters.

I suppose I was lazy about "Close\Cancel" as I often use the red "X" myself and the customer didn't comment. However since the form is modeless there is no reason to kill it automatically on either of the three row actions so I canx that a added a close\exit button.

Like you, I am stumped by the how the "L" is sorted in the sampe file but it isn't a issue in the actual glossary.

I tinkered with a few of the other sorts (e.g., bubble was one) but they seem to be very unhappy with the multi-demension.

I revised the code in the actual document attached to incorporate your counter for the redim.

Thanks.

[fumei]

The only thing I can think of vis-a-vis the sort is that the first "L" is found (ListCount = 10), and then the second (ListCount = 11). The sort puts additional items (of the same value) prior to the previous one.


Yup. Add another "L" and the sort comes out:

Third Found
Second Found
First Found

I do not think there is any way around this except for a long-winded manual sort. Yuck. It would be bad enough with a one dimensional list, but as you need that other number in order to use it for jumping to that row....YUCK!

[gmaxey]

Oh ye of little faith:

Private Sub ListBox1_Click()
Dim iCorrect As Long
Dim pCount As Long
pCount = 1
iCorrect = Me.ListBox1.Column(1)
Do While Me.ListBox1.List(Me.ListBox1.ListIndex) = Me.ListBox1.List(Me.ListBox1.ListIndex + pCount)
iCorrect = iCorrect - 1
pCount = pCount + 1
Loop
pCount = 1
Do While Me.ListBox1.List(Me.ListBox1.ListIndex) = Me.ListBox1.List(Me.ListBox1.ListIndex - pCount)
iCorrect = iCorrect + 1
pCount = pCount + 1
Loop
ActiveDocument.Tables(1).Cell(iCorrect, 1).Select
End Sub

[gmaxey]

Faith and a little error handling ;-)

Private Sub ListBox1_Click()
Dim iCorrect As Long
Dim pCount As Long
pCount = 1
iCorrect = Me.ListBox1.Column(1)
On Error GoTo Err_Handler1
Do While Me.ListBox1.List(Me.ListBox1.ListIndex) = Me.ListBox1.List(Me.ListBox1.ListIndex + pCount)
iCorrect = iCorrect - 1
pCount = pCount + 1
Loop
Err1_ReEntry:
On Error GoTo 0
pCount = 1
On Error GoTo Err_Handler2
Do While Me.ListBox1.List(Me.ListBox1.ListIndex) = Me.ListBox1.List(Me.ListBox1.ListIndex - pCount)
iCorrect = iCorrect + 1
pCount = pCount + 1
Loop
Err2_ReEntry:
ActiveDocument.Tables(1).Cell(iCorrect, 1).Select
Exit Sub
Err_Handler1:
Resume Err1_ReEntry
Err_Handler2:
Resume Err2_ReEntry
End Sub