Visual Basic Code of the Week (COTW)
http://www.codeoftheweek.com
Issue #25
All content and source code is Copyright (c) 1998 by C&D Programming Corp. No part of this issue can be reprinted or distributed in any manner without express written permission of C&D Programming Corp.

NEW! Online Catalog now available!

We have entered a partnership with VBXtras to provide many development tools available for sale on our web site. For a limited time we are offering a FREE one year subscription for anyone who purchases any products through our web site. If you are currently shopping for some cool tools, check out http://www.codeoftheweek.com/catalog.html

This area is new and does not yet have all products online. If there is something particular you are looking for (and can't find it on our site), please let us know. We probably can get it for you at a great price!

Advertising

If you are interested in advertising in COTW (our rates are VERY reasonable), please email us at sponsor@codeoftheweek.com


Requirements for this Issue

The source code in this issue is designed for Visual Basic 4.0 16-bit and higher. It will probably work in VB3 with some minor changes (such as the removal of the vbNullString constant).

In this Issue

This issue introduces a subroutine that eliminates duplicate values in listboxes, variant arrays and string arrays. It provides a framework to expand the subroutine to use other with objects.

RemoveDuplicates

Description

This routine works fastest when you have lots of duplicates in your objects. The approach used for listboxes is a little different than the approach used for arrays.

When removing duplicates from a listbox the routine starts at the beginning of the list and compares it with each element in the list (starting with the last element first). If it finds a duplicate it will remove that element and continue until all items have been checked. It will then move to the second element and repeat the process until it is completed.

When removing duplicates from arrays the routine starts at the beginning of the array and compares it with each element in the array. If it finds a duplicate it assigns that element the value vbNullString. It will continue this process until it is complete. Once it has removed all the duplicates it will then copy all items that are not vbNullString to a new array. When this process is complete it will copy the new array back into the original array.

Depending on your application you might need to change the value used when erasing the values in the arrays from vbNullString to something else.

Declaration

Public Sub RemoveDuplicates(vList As Variant)

Parameters

Returns

vList will be returned with all unique values. The type of vList depends on how it is called.

Sample Usage

Below shows several examples. There is one for each type RemoveDuplicates supports (ListBox, String(), Variant())

    Dim x As Integer
    Dim v As Variant
    Dim sData() As String

    Randomize

    ' Test with a ListBox
    For x = 1 To 500
        List1.AddItem "abc" & Int(Rnd * 200)
    Next
    RemoveDuplicates List1


    ' Test with a Variant Array
    ReDim v(1 To 500)
    For x = 1 To 500
        v(x) = "abc" & Int(Rnd * 200)
    Next
    RemoveDuplicates v

    ' Test with a String Array
    ReDim sData(1 To 500)
    For x = 1 To 500
        sData(x) = "abc" & Int(Rnd * 200)
    Next
    RemoveDuplicates sData

Source Code

Just paste this code into any module and change the name of the module to basArrays.

'----------------------------------------------------------------------
'
'   Module Name:    basArrays
'   Written By:     C&D Programming Corp.
'   Create Date:    2/21/98
'   Copyright:      Copyright 1998 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Public Sub RemoveDuplicates(vList As Variant)
    Dim sItem As String
    Dim x As Long
    Dim y As Long

    On Error Goto Handler

    Select Case TypeName(vList)
        Case "ListBox"
            Dim lst As ListBox
            ' For speed.  If we know what type we are
            ' looking at things will run faster.
            Set lst = vList
            ' if we have one or less items in our list
            ' there can not be any duplicates.
            If lst.ListCount <= 1 Then
                Exit Sub
            End If
            x = -1
            While x < lst.ListCount - 1
                x = x + 1
                sItem = lst.List(x)         ' faster this way
                For y = lst.ListCount - 1 To x + 1 Step -1
                    If sItem = lst.List(y) Then
                        lst.RemoveItem y
                    End If
                Next
            Wend

        Case "Variant()", "String()"
            Dim vTemp As Variant
            Dim lLowerBound As Long
            Dim lUpperBound As Long

            ' if we have an empty array there can't be any
            ' duplicates...
            If IsEmpty(vList) Then
                Exit Sub
            End If
            lLowerBound = LBound(vList)
            lUpperBound = UBound(vList)
            ' if we have one or less items in our list
            ' there can not be any duplicates.
            If lUpperBound - lLowerBound <= 0 Then
                Exit Sub
            End If

            ' search through the array and null out the
            ' duplicate values.
            x = lLowerBound - 1
            While x < lUpperBound
                x = x + 1
                If vList(x) <> vbNullString Then
                    sItem = vList(x)         ' faster this way
                    For y = lUpperBound To x + 1 Step -1
                        If sItem = vList(y) Then
                            vList(y) = vbNullString
                        End If
                    Next
                End If
            Wend

            ' create temporary array to manage unique values
            ReDim vTemp(lLowerBound To lUpperBound)
            ' copy all the unique values to a new
            ' temporary array
            y = lLowerBound - 1
            For x = lLowerBound To lUpperBound
                If vList(x) <> vbNullString Then
                    y = y + 1
                    vTemp(y) = vList(x)
                End If
            Next

            ' y is the new upper bound, so resize the
            ' unique array.  erase the old array and
            ' resize it.  Then assign the temporary
            ' array to the original array.
            ReDim Preserve vTemp(lLowerBound To y)
            Erase vList
            ReDim vList(lLowerBound To y)

            ' If it is a string array we have to copy each
            ' element individually.  If it is a variant
            ' array we can just assign it to the new variant.
            ' this is one of the cool things about variants.
            ' Too bad there is a fair amount of overhead
            ' involved when using variants.
            If TypeName(vList) = "String()" Then
                For x = lLowerBound To y
                    vList(x) = vTemp(x)
                Next
            Else
                vList = vTemp
            End If

            Erase vTemp
    End Select
    Exit Sub

Handler:
    Err.Raise Err.Number, Err.Source, Err.Description
End Sub

This document is available on the web

Paid subscribers can view this issue in HTML format. There is no additional source or information in the HTML formatted document. It just looks a little better since we have included some HTML formatting. Just point your browser to http://www.codeoftheweek.com/membersonly/bi/0025.html

Summary

That concludes this issue of COTW. We hope you find the source code useful in your development.

The below describes the ways you can supply us some feedback about COTW. We would like to see our members help mold COTW into the best Visual Basic source code resource available. But to do that we need your feedback about what you like and what you do not like about COTW.

How to tell us what you think

If you have any suggestions for topics you would like to see covered or questions about this issue, please email them to info@codeoftheweek.com or use online feedback form at http://www.codeoftheweek.com/feedback.html.

If you have any source code you would like to submit for possible inclusion in COTW, please fill out our online submission form at http://www.codeoftheweek.com/submission.html.

Contact Information

C&D Programming Corp.
PO Box 20128
Floral Park, NY 11002-0128
Phone or Fax: (212) 504-7945
Email: info@codeoftheweek.com
Web: http://www.codeoftheweek.com

Subscription Update

Thank you for trying Code of the Week for Visual Basic.

Your free trial expires after you receive your fourth issue. If you want to continue to receive Code of the Week you can get 52 issues of COTW for only $19.95. This is a full year of Visual Basic source code and information to help with all your development. So don't wait, subscribe now! The quickest way to subscribe is to jump to our online order form at http://www.codeoftheweek.com/order.html