Compare Listbox values with Collection values

Discussion in 'Microsoft Excel Programming' started by Stuart, Sep 19, 2003.

  1. Stuart

    Stuart Guest

    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
     
    Stuart, Sep 19, 2003
    #1
    1. Advertisements

  2. Stuart

    Tom Ogilvy Guest

    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 D3:D24 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("D3:D24")
    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 <> wrote in message
    news:...
    > 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
    >
    >
     
    Tom Ogilvy, Sep 19, 2003
    #2
    1. Advertisements

  3. Stuart

    Stuart Guest

    Many thanks indeed.
    It was mainly the use of arrays and Match
    that was missing from my attempts.

    Regards.

    "Tom Ogilvy" <> wrote in message
    news:...
    > 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 D3:D24 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("D3:D24")
    > 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 <> wrote in message
    > news:...
    > > 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
     
    Stuart, Sep 20, 2003
    #3
    1. Advertisements

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. Rob
    Replies:
    1
    Views:
    1,123
    Dave Peterson
    Jul 9, 2003
  2. Matt Williamson

    compare data from one column with another and compare result to yet another

    Matt Williamson, Sep 25, 2003, in forum: Microsoft Excel Programming
    Replies:
    1
    Views:
    732
    Tom Ogilvy
    Sep 25, 2003
  3. ARB
    Replies:
    0
    Views:
    1,368
  4. Ken Soenen

    String compare doesn't compare?

    Ken Soenen, Jan 16, 2006, in forum: Microsoft Excel Programming
    Replies:
    1
    Views:
    239
    Dave Peterson
    Jan 16, 2006
  5. Erazmus
    Replies:
    2
    Views:
    290
    Erazmus
    Sep 17, 2007
Loading...

Share This Page