PC Review


Reply
Thread Tools Rate Thread

Compare Listbox values with Collection values

 
 
Stuart
Guest
Posts: n/a
 
      19th Sep 2003
Say frm1.lb1.Column(1) and Column(2) are populated
from a range in a worksheet.
Say a Collection has been built of unique and sorted
values.

Can I compare the values in the Collection with the
values in Column(1) of the listbox such that:

a) if the the value exists in the lb, then ok.
b) if it doesn't, then add it to the lb.
c) if there's a value in the lb that's not in the Collection,
then remove it (and the lb.Column(2) value from the lb.

Is this possible, please?

Regards.


---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003


 
Reply With Quote
 
 
 
 
Tom Ogilvy
Guest
Posts: n/a
 
      19th Sep 2003
Put this is an empty workbook with a form named Frm1 having a listbox named
lb1 and a commandbutton named commandbutton1.

On sheet1, put in a list of sorted values in B3:B24 and corresponding names
in C3:C24. In D324 put in sorted or unsorted entries similar to those in
B3:B24 (some added, some missing).

Execute AA_showform and then press Commandbutton1 to adjust the list.


In a general module:
Option Explicit

Sub AA_showform()
frm1.Show
End Sub


Sub Tester3()
Dim NoDupes As New Collection
Dim rng As Range
Dim i As Long
Dim vVal As Variant
Dim itm As Variant
Dim res As Variant
Dim varr2 As Variant, cnt As Long
Dim varr As Variant, varr1 As Variant

' set up a collection
Set rng = Worksheets("sheet1").Range("D324")
RemoveDuplicates rng, NoDupes
' End Setup a collection

With frm1.lb1
cnt = .ListCount
For i = .ListCount - 1 To 0 Step -1
vVal = Empty
On Error Resume Next
vVal = NoDupes(.List(i, 0))
' Debug.Print i, vVal
On Error GoTo 0
If IsEmpty(vVal) Then
.RemoveItem i
cnt = cnt - 1
End If
Next
varr = .List
ReDim varr1(1 To cnt, 1 To 1)
For i = 1 To cnt
varr1(i, 1) = .List(i - 1, 0)
Next
ReDim varr2(1 To 2, 1 To 1)
For Each itm In NoDupes
res = Application.Match(itm, varr1, 1)
If IsError(res) Then
varr2(1, UBound(varr2, 2)) = itm
varr2(2, UBound(varr2, 2)) = -1
ReDim Preserve varr2(1 To 2, 1 To _
UBound(varr2, 2) + 1)
Else
If itm <> varr1(res, 1) Then
varr2(1, UBound(varr2, 2)) = itm
varr2(2, UBound(varr2, 2)) = res
ReDim Preserve varr2(1 To 2, 1 To _
UBound(varr2, 2) + 1)
End If
End If

Next
For i = UBound(varr2, 2) - 1 To 1 Step -1
If varr2(2, i) = -1 Then
.AddItem varr2(1, i), 0
Else
.AddItem varr2(1, i), varr2(2, i)
End If
Next
End With
End Sub

Sub RemoveDuplicates(rng As Range, NoDupes As Collection)
Dim AllCells As Range, Cell As Range
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item
' based on John Walkenbachs
' http://j-walk.com/ss/excel/tips/tip47.htm
' The items are in A1:A105
' Set AllCells = Range("A1:A105")
Set AllCells = rng
' The next statement ignores the error caused
' by attempting to add a duplicate key to the collection.
' The duplicate is not added - which is just what we want!
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
' Note: the 2nd argument (key) for the Add method must be a string
Next Cell

' Resume normal error handling
On Error GoTo 0

' Sort the collection (optional)
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) > NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, before:=j
NoDupes.Add Swap2, before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i

' Add the sorted, non-duplicated items to a ListBox
' For Each Item In NoDupes
' UserForm1.ListBox1.AddItem Item
' Next Item

' Show the UserForm

End Sub


----------
in the Frm1 module:

Private Sub CommandButton1_Click()
Tester3
End Sub

Private Sub UserForm_Initialize()
lb1.RowSource = ""
lb1.List = Worksheets("Sheet1").Range("B3:C24").Value
End Sub


--
Regards,
Tom Ogilvy


Stuart <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> Say frm1.lb1.Column(1) and Column(2) are populated
> from a range in a worksheet.
> Say a Collection has been built of unique and sorted
> values.
>
> Can I compare the values in the Collection with the
> values in Column(1) of the listbox such that:
>
> a) if the the value exists in the lb, then ok.
> b) if it doesn't, then add it to the lb.
> c) if there's a value in the lb that's not in the Collection,
> then remove it (and the lb.Column(2) value from the lb.
>
> Is this possible, please?
>
> Regards.
>
>
> ---
> Outgoing mail is certified Virus Free.
> Checked by AVG anti-virus system (http://www.grisoft.com).
> Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003
>
>



 
Reply With Quote
 
 
 
 
Stuart
Guest
Posts: n/a
 
      20th Sep 2003
Many thanks indeed.
It was mainly the use of arrays and Match
that was missing from my attempts.

Regards.

"Tom Ogilvy" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> Put this is an empty workbook with a form named Frm1 having a listbox

named
> lb1 and a commandbutton named commandbutton1.
>
> On sheet1, put in a list of sorted values in B3:B24 and corresponding

names
> in C3:C24. In D324 put in sorted or unsorted entries similar to those

in
> B3:B24 (some added, some missing).
>
> Execute AA_showform and then press Commandbutton1 to adjust the list.
>
>
> In a general module:
> Option Explicit
>
> Sub AA_showform()
> frm1.Show
> End Sub
>
>
> Sub Tester3()
> Dim NoDupes As New Collection
> Dim rng As Range
> Dim i As Long
> Dim vVal As Variant
> Dim itm As Variant
> Dim res As Variant
> Dim varr2 As Variant, cnt As Long
> Dim varr As Variant, varr1 As Variant
>
> ' set up a collection
> Set rng = Worksheets("sheet1").Range("D324")
> RemoveDuplicates rng, NoDupes
> ' End Setup a collection
>
> With frm1.lb1
> cnt = .ListCount
> For i = .ListCount - 1 To 0 Step -1
> vVal = Empty
> On Error Resume Next
> vVal = NoDupes(.List(i, 0))
> ' Debug.Print i, vVal
> On Error GoTo 0
> If IsEmpty(vVal) Then
> .RemoveItem i
> cnt = cnt - 1
> End If
> Next
> varr = .List
> ReDim varr1(1 To cnt, 1 To 1)
> For i = 1 To cnt
> varr1(i, 1) = .List(i - 1, 0)
> Next
> ReDim varr2(1 To 2, 1 To 1)
> For Each itm In NoDupes
> res = Application.Match(itm, varr1, 1)
> If IsError(res) Then
> varr2(1, UBound(varr2, 2)) = itm
> varr2(2, UBound(varr2, 2)) = -1
> ReDim Preserve varr2(1 To 2, 1 To _
> UBound(varr2, 2) + 1)
> Else
> If itm <> varr1(res, 1) Then
> varr2(1, UBound(varr2, 2)) = itm
> varr2(2, UBound(varr2, 2)) = res
> ReDim Preserve varr2(1 To 2, 1 To _
> UBound(varr2, 2) + 1)
> End If
> End If
>
> Next
> For i = UBound(varr2, 2) - 1 To 1 Step -1
> If varr2(2, i) = -1 Then
> .AddItem varr2(1, i), 0
> Else
> .AddItem varr2(1, i), varr2(2, i)
> End If
> Next
> End With
> End Sub
>
> Sub RemoveDuplicates(rng As Range, NoDupes As Collection)
> Dim AllCells As Range, Cell As Range
> Dim i As Integer, j As Integer
> Dim Swap1, Swap2, Item
> ' based on John Walkenbachs
> ' http://j-walk.com/ss/excel/tips/tip47.htm
> ' The items are in A1:A105
> ' Set AllCells = Range("A1:A105")
> Set AllCells = rng
> ' The next statement ignores the error caused
> ' by attempting to add a duplicate key to the collection.
> ' The duplicate is not added - which is just what we want!
> On Error Resume Next
> For Each Cell In AllCells
> NoDupes.Add Cell.Value, CStr(Cell.Value)
> ' Note: the 2nd argument (key) for the Add method must be a string
> Next Cell
>
> ' Resume normal error handling
> On Error GoTo 0
>
> ' Sort the collection (optional)
> For i = 1 To NoDupes.Count - 1
> For j = i + 1 To NoDupes.Count
> If NoDupes(i) > NoDupes(j) Then
> Swap1 = NoDupes(i)
> Swap2 = NoDupes(j)
> NoDupes.Add Swap1, before:=j
> NoDupes.Add Swap2, before:=i
> NoDupes.Remove i + 1
> NoDupes.Remove j + 1
> End If
> Next j
> Next i
>
> ' Add the sorted, non-duplicated items to a ListBox
> ' For Each Item In NoDupes
> ' UserForm1.ListBox1.AddItem Item
> ' Next Item
>
> ' Show the UserForm
>
> End Sub
>
>
> ----------
> in the Frm1 module:
>
> Private Sub CommandButton1_Click()
> Tester3
> End Sub
>
> Private Sub UserForm_Initialize()
> lb1.RowSource = ""
> lb1.List = Worksheets("Sheet1").Range("B3:C24").Value
> End Sub
>
>
> --
> Regards,
> Tom Ogilvy
>
>
> Stuart <(E-Mail Removed)> wrote in message
> news:(E-Mail Removed)...
> > Say frm1.lb1.Column(1) and Column(2) are populated
> > from a range in a worksheet.
> > Say a Collection has been built of unique and sorted
> > values.
> >
> > Can I compare the values in the Collection with the
> > values in Column(1) of the listbox such that:
> >
> > a) if the the value exists in the lb, then ok.
> > b) if it doesn't, then add it to the lb.
> > c) if there's a value in the lb that's not in the Collection,
> > then remove it (and the lb.Column(2) value from the lb.
> >
> > Is this possible, please?
> >
> > Regards.
> >
> >
> > ---
> > Outgoing mail is certified Virus Free.
> > Checked by AVG anti-virus system (http://www.grisoft.com).
> > Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003
> >
> >

>
>



---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003


 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Re: compare values between combobox and listbox Stuart McCall Microsoft Access Form Coding 3 18th Feb 2010 10:49 PM
Collection problems (create Collection object, add data to collection, bind collection to datagrid) Řyvind Isaksen Microsoft ASP .NET 1 18th May 2007 10:24 AM
Collection problems (create Collection object, add data to collection, bind collection to datagrid) Řyvind Isaksen Microsoft Dot NET 1 18th May 2007 10:24 AM
Moving listbox item from listbox to listbox Kevin Quigley Microsoft Dot NET 2 2nd Jun 2004 11:34 AM
listbox.value not equal to listbox.list(listbox.listindex,0) ARB Microsoft Excel Programming 0 22nd Oct 2003 12:46 AM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 02:07 PM.