|
Visual Basic (VB and VBA) |
|
Copyright 1999-2001 Christopher Greaves. All rights reserved. Home Page and email to [email protected] |
| If in doubt, record a macro and inspect the entrails! |
Please read the DISCLAIMER.
Here is an INDEX to all the procedures.
You will probably need one copy of my GLOBAL DECLARATIONS.
Public Function LoadUniqueListBoxToListBox(lbIn As ListBox, lbOut As ListBox, Optional blnCaseSensitive As Boolean = True)
' Procedure : LoadUniqueListBoxToListBox
' Description: Load only unique items from the Input Listbox to the Output listbox.
' By: Chris Greaves Inc.
' Inputs: Two listboxes, case sensitive flag..
' Returns: None.
' Assumes: Nothing
' Side Effects: None
' Tested: By the calls shown below.
Dim strAr() As String
ReDim strAr(0)
Dim i As Integer
For i = 0 To lbIn.ListCount - 1
strAr(UBound(strAr)) = lbIn.List(i)
ReDim Preserve strAr(UBound(strAr) + 1)
Next i
' Sort the array
If UBound(strAr) > 0 Then
ReDim Preserve strAr(UBound(strAr) - 1)
Call LogFile(strcApplication, "Calling qsort from " & "LoadUniqueListBoxToListBox")
Call QSort(strAr, 0, UBound(strAr, 1), False)
Else
End If
' Read back the array; clear the combobox and drop duplicate (sorted) entries.
Dim strOld As String
lbOut.Clear
strOld = strAr(0)
lbOut.AddItem strOld
Dim lngRow As Long
For lngRow = 1 To UBound(strAr)
If blnCaseSensitive Then
If strOld = strAr(lngRow) Then ' found a duplicate on this column-key
Else ' Not a duplicate; copy it back to the combo.
strOld = strAr(lngRow)
lbOut.AddItem strOld
End If
Else
If UCase(strOld) = UCase(strAr(lngRow)) Then ' found a duplicate on this column-key
Else ' Not a duplicate; copy it back to the combo.
strOld = strAr(lngRow)
lbOut.AddItem strOld
End If
End If
Next lngRow
End Function
| We all knew nothing when we started … |
|
Home Page and Contact Information Send email to [email protected]. This page was last updated Thursday, November 15, 2001 |