Solved

Manipulating a dynamic array

Posted on 1998-11-24
2
147 Views
Last Modified: 2010-05-03
I have a comma-separated string which I collect from a txt-file. I want to append values to this string, but not if the value already is in the string. I have now converted it to an array with Split, but I don't know if that will simplify the problem. Furthermore I don't know how long the string/array is (how many values in it), and the values that is inserted and "double-checked" is supposed to be virtually anything.

Which way to go and how?
0
Comment
Question by:isidor
2 Comments
 
LVL 14

Accepted Solution

by:
waty earned 100 total points
ID: 1446489
Use collection instead, add the string as a key, so, when you add a new string, you will be notified directly if there is a duplicate.
By the way, here are some code to see if there is duplicates, and also other routines for arrays and collections :

' #VBIDEUtils#************************************************************
' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : waty.thierry@usa.net
' * Date             : 25/09/98
' * Time             : 13:20
' * Module Name      : Array_Module
' * Module Filename  : Array.bas
' **********************************************************************
' * Comments         : Some routines for Array and collections.
' *
' *
' **********************************************************************

Option Explicit

Private Const ordSortVal = 0
Private Const ordSortText = 1
Private Const ordSortBin = 2
Private Const ordSortLen = 3

Private ordMode         As Integer
Private fSortHiToLo     As Integer

Public Function RemoveDupes(vData As Variant)
   ' ---------------------------------------------------------
   ' Syntax:     RemoveDupes TmpAray()
   ' Parameters:
   '     vData - A variant pointing to an array to be parsed
   '             for duplicate values assuming the data has
   '             already been sorted by some other means
   ' ---------------------------------------------------------
   ' Test to see if an array was passed
   ' ---------------------------------------------------------

   If Not IsArray(vData) Then Exit Function
   ' ---------------------------------------------------------
   ' Define variables
   ' ---------------------------------------------------------
   Dim lCurIndex As Long
   Dim lNextIndex As Long
   Dim lNewIndex As Long
   Dim i As Long
   Dim Hi As Long
   Dim vtemp As Variant
   ' ---------------------------------------------------------
   ' Initialize variables
   ' ---------------------------------------------------------
   Hi = UBound(vData)   ' upper end of the array

   lNewIndex = 1
   i = 1
   ReDim tmpAray(1 To Hi) As String
   ' ---------------------------------------------------------
   ' Move the first valid value to the new array
   ' ---------------------------------------------------------
   Do
      If Len(vData(i)) <> 0 Then
         tmpAray(lNewIndex) = vData(i)
         Exit Do
      End If

      i = i + 1   ' Increment the counter

   Loop
   ' ---------------------------------------------------------

   ' Increment the counter so that we start comparing with
   ' the next value in the FOR NEXT loop
   ' ---------------------------------------------------------
   i = i + 1
   ' ---------------------------------------------------------
   ' Start the comparison process.  We will go thru every
   ' item in the array and look for duplicate values.
   ' ---------------------------------------------------------
   For lCurIndex = i To Hi

      ' increment the counter for the next

      ' item in the array and empty the
      ' temporary holding variable
      lNextIndex = lCurIndex + 1
      vtemp = ""
      ' if we have reached the end of the
      ' array then leave before we get a
      ' "Subscript out of range" error.
      If lNextIndex > Hi Then Exit For
      ' See if we already have it in the new
      ' array.  If yes, then empty the array item
      If vData(lCurIndex) = tmpAray(lNewIndex) Then
         vData(lCurIndex) = ""

      End If
      ' if the value is greater than an empty string,
      ' move the data to a temporary holding variable
      If Len(Trim(vData(lCurIndex))) > 0 Then
         vtemp = vData(lCurIndex)
         ' See if the data is in the array starting
         ' from the next position and go to the end.
         ' If it is not in the array then add it
         ' to the new array and increment the count.
         ' We will pass the complete array, the data

         ' to look for, and the stating point in the
         ' array.
         If IsInArray(vData, vtemp, lNextIndex) Then
            vData(lCurIndex) = ""
         Else
            ' increment the index for the new array
            ' and add the item of data to it.
            lNewIndex = lNewIndex + 1
            tmpAray(lNewIndex) = vtemp
         End If
      End If
      '
   Next
   ' ---------------------------------------------------------

   ' Empty the passed array
   ' ---------------------------------------------------------
   ReDim vData(1 To Hi) As String
   ' ---------------------------------------------------------
   ' if you are using an external sort routine, then
   ' resort the data to move all the null strings to the
   ' end of the array.
   ' ---------------------------------------------------------
   ' sort_routine tmpAray()
   ' ---------------------------------------------------------
   ' Transfer data from the temp(New) array back into

   ' the passed array
   ' ---------------------------------------------------------
   For lCurIndex = 1 To Hi
      vData(lCurIndex) = tmpAray(lCurIndex)
   Next
End Function

Private Function IsInArray(vData As Variant, vSrchData As Variant, lStart As Long) As Boolean
   ' ---------------------------------------------------------
   ' Syntax:     IsInArray tmpArray(), sSrchData, lStart
   '
   ' Parameters:
   '     vData - A variant pointing to an array to be
   '             parsed for duplicate values

   '
   '  vSrcData - A value in the array to look for
   '
   '    lStart - The starting point in the array
   '
   ' We want to determine if an item is already
   ' in this array.  We do this by looping through and
   ' comparing the sSrchData with each item in the array.
   ' Since we started with the next item in the array, we
   ' should not have a duplicate.
   ' ---------------------------------------------------------
   ' Test to see if an array was passed
   ' ---------------------------------------------------------

   If Not IsArray(vData) Then Exit Function
   ' ---------------------------------------------------------
   ' Define local variable
   ' ---------------------------------------------------------
   Dim Hi As Long
   ' ---------------------------------------------------------
   ' upper end of the array
   ' ---------------------------------------------------------
   Hi = UBound(vData)
   ' ---------------------------------------------------------
   ' start of at the designated array element

   ' ---------------------------------------------------------
   Do Until lStart > Hi
      ' Look for a match in the array
      ' If vData(lStart) = vSrchData Then
      If StrComp(vData(lStart), vSrchData, 0) = 0 Then
         '
         ' We found a match in the array
         IsInArray = True
         Exit Function
         '
      End If
      ' increment the array index counter
      lStart = lStart + 1
   Loop
   ' ---------------------------------------------------------

   ' The search item could not be found in the array
   ' ---------------------------------------------------------
   IsInArray = False
End Function

Sub SortArray(aTarget() As Variant, iFirst As Integer, iLast As Integer)
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 30/10/98
   ' * Time             : 14:18
   ' * Module Name      : Array_Module
   ' * Module Filename  : D:\TWA\Lib\Array.bas
   ' * Procedure Name   : SortArray
   ' * Parameters       :
   ' *                    aTarget() As Variant
   ' *                    iFirst As Integer
   ' *                    iLast As Integer
   ' **********************************************************************
   ' * Comments         : Sort an array using QuickSort algorithm
   ' *
   ' *
   ' **********************************************************************
   
   Dim vSplit As Variant

   If iFirst < iLast Then

      ' Only two elements in this subdivision; exchange if
      ' they are out of order, and end recursive calls
      If iLast - iFirst = 1 Then
         If SortCompare(aTarget(iFirst), aTarget(iLast)) > 0 Then
            SortSwap aTarget(iFirst), aTarget(iLast)
         End If
      Else

         Dim i As Integer, J As Integer, iRand As Integer

         ' Pick pivot element at random and move to end
         ' (consider calling Randomize before sorting)
         iRand = GetRandom(iFirst, iLast)
         SortSwap aTarget(iLast), aTarget(iRand)
         vSplit = aTarget(iLast)
         Do

            ' Move in from both sides toward pivot element
            i = iFirst: J = iLast
            Do While (i < J) And _
                     SortCompare(aTarget(i), vSplit) <= 0
               i = i + 1
            Loop
            Do While (J > i) And _
                     SortCompare(aTarget(J), vSplit) >= 0
               J = J - 1
            Loop

            ' If you haven't reached pivot element, it means
            ' that the two elements on either side are out of
            ' order, so swap them
            If i < J Then
               SortSwap aTarget(i), aTarget(J)
            End If
         Loop While i < J

         ' Move pivot element back to its proper place
         SortSwap aTarget(i), aTarget(iLast)

         ' Recursively call SortArray (pass smaller
         ' subdivision first to use less stack space)
         If (i - iFirst) < (iLast - i) Then
            SortArray aTarget(), iFirst, i - 1
            SortArray aTarget(), i + 1, iLast
         Else
            SortArray aTarget(), i + 1, iLast
            SortArray aTarget(), iFirst, i - 1
         End If
      End If
   End If

End Sub

Sub SortCollection(nTarget As Collection, iFirst As Integer, iLast As Integer)
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 30/10/98
   ' * Time             : 14:19
   ' * Module Name      : Array_Module
   ' * Module Filename  : D:\TWA\Lib\Array.bas
   ' * Procedure Name   : SortCollection
   ' * Parameters       :
   ' *                    nTarget As Collection
   ' *                    iFirst As Integer
   ' *                    iLast As Integer
   ' **********************************************************************
   ' * Comments         : Sort a collection using QuickSort algorithm
   ' *
   ' *
   ' **********************************************************************
   
   Dim vSplit        As Variant
   Static fRand      As Integer

   If fRand = False Then
      Randomize
      fRand = True
   End If

   If iFirst < iLast Then

      ' Only two elements in this subdivision; exchange if
      ' they are out of order, and end recursive calls
      If iLast - iFirst = 1 Then
         If SortCompare(nTarget(iFirst), nTarget(iLast)) > 0 Then
            CollectionSwap nTarget, iFirst, iLast
         End If
      Else

         Dim i As Integer, J As Integer, iRand As Integer

         ' Pick pivot element at random and move to end
         ' (consider calling Randomize before sorting)
         iRand = GetRandom(iFirst, iLast)
         CollectionSwap nTarget, iLast, iRand
         vSplit = nTarget(iLast)
         Do

            ' Move in from both sides toward pivot element
            i = iFirst: J = iLast
            Do While (i < J) And _
                     SortCompare(nTarget(i), vSplit) <= 0
               i = i + 1
            Loop
            Do While (J > i) And _
                     SortCompare(nTarget(J), vSplit) >= 0
               J = J - 1
            Loop

            ' If you haven't reached pivot element, it means
            ' that the two elements on either side are out of
            ' order, so swap them
            If i < J Then
               CollectionSwap nTarget, i, J
            End If
         Loop While i < J

         ' Move pivot element back to its proper place
         CollectionSwap nTarget, i, iLast

         ' Recursively call SortCollection (pass smaller
         ' subdivision first to use less stack space)
         If (i - iFirst) < (iLast - i) Then
            SortCollection nTarget, iFirst, i - 1
            SortCollection nTarget, i + 1, iLast
         Else
            SortCollection nTarget, i + 1, iLast
            SortCollection nTarget, iFirst, i - 1
         End If
      End If
   End If

End Sub

Function BSearchArray(av() As Variant, vKey As Variant, iPos As Integer) As Boolean

   Dim iLo           As Integer
   Dim iHi           As Integer
   Dim iComp         As Integer
   Dim iMid          As Integer

   iLo = LBound(av): iHi = UBound(av)
   Do
      iMid = iLo + ((iHi - iLo) \ 2)
      iComp = SortCompare(av(iMid), vKey)
      Select Case iComp
         Case 0
            ' Item found
            iPos = iMid
            BSearchArray = True
            Exit Function
         Case Is > 0
            ' Item is in upper half
            iHi = iMid
            If iLo = iHi Then Exit Do
         Case Is < 0
            ' Item is in lower half
            iLo = iMid + 1
            If iLo > iHi Then Exit Do
      End Select
   Loop

   ' Item not found, but return position to insert
   iPos = iMid - (iComp < 0)
   BSearchArray = False

End Function

Function BSearchCollection(n As Collection, vKey As Variant, iPos As Integer) As Boolean
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 25/09/98
   ' * Time             : 13:20
   ' * Module Name      : Array_Module
   ' * Module Filename  : Array.bas
   ' * Procedure Name   : BSearchCollection
   ' * Parameters       :
   ' *                    n As Collection
   ' *                    vKey As Variant
   ' *                    iPos As Integer
   ' **********************************************************************
   ' * Comments         : Search for a key in a collection
   ' *
   ' *
   ' **********************************************************************

   Dim iLo           As Integer
   Dim iHi           As Integer
   Dim iComp         As Integer
   Dim iMid          As Integer

   iLo = 1: iHi = n.count
   Do
      iMid = iLo + ((iHi - iLo) \ 2)
      iComp = SortCompare(n(iMid), vKey)
      Select Case iComp
         Case 0
            ' Item found
            iPos = iMid
            BSearchCollection = True
            Exit Function
         Case Is > 0
            ' Item is in upper half
            iHi = iMid
            If iLo = iHi Then Exit Do
         Case Is < 0
            ' Item is in lower half
            iLo = iMid + 1
            If iLo > iHi Then Exit Do
      End Select
   Loop
   ' Item not found, but return position to insert
   iPos = iMid - (iComp < 0)
   BSearchCollection = False

End Function

Sub ShuffleArray(A() As Variant)

   Dim iFirst As Integer, iLast As Integer
   iFirst = LBound(A): iLast = UBound(A)

   ' Randomize array
   Dim i As Integer, v As Variant, iRnd As Integer
   For i = iLast To iFirst + 1 Step -1
      ' Swap random element with last element
      iRnd = GetRandom(iFirst, i)
      SortSwap A(i), A(iRnd)
   Next

End Sub

Sub ShuffleCollection(n As Collection)

   Dim iFirst As Integer, iLast As Integer
   iFirst = 1: iLast = n.count

   ' Randomize collection
   Dim i As Integer, v As Variant, iRnd As Integer
   For i = iLast To iFirst + 1 Step -1
      ' Swap random element with last element
      iRnd = GetRandom(iFirst, i)
      CollectionSwap n, i, iRnd
   Next

End Sub

Sub SortSwap(v1 As Variant, v2 As Variant)

   Dim vt As Variant

   vt = v1
   v1 = v2
   v2 = vt

End Sub

Sub CollectionSwap(n As Collection, i1 As Integer, i2 As Integer)

   Dim vt As Variant

   vt = n(i1)
   n.Add n(i2), , , i1
   n.Remove i1
   n.Add vt, , , i2
   n.Remove i2

End Sub

Public Function SortCompare(v1 As Variant, v2 As Variant) As Integer

   ' Use string comparisons only on strings
   If TypeName(v1) <> "String" Then ordMode = ordSortVal

   Dim i As Integer
   Select Case ordMode
         ' Sort by value (same as ordSortBin for strings)
      Case ordSortVal
         If v1 < v2 Then
            i = -1
         ElseIf v1 = v2 Then
            i = 0
         Else
            i = 1
         End If
         ' Sort case-insensitive
      Case ordSortText
         i = StrComp(v1, v2, 1)
         ' Sort case-sensitive
      Case ordSortBin
         i = StrComp(v1, v2, 0)
         ' Sort by string length
      Case ordSortLen
         If Len(v1) = Len(v2) Then
            If v1 = v2 Then
               i = 0
            ElseIf v1 < v2 Then
               i = -1
            Else
               i = 1
            End If
         ElseIf Len(v1) < Len(v2) Then
            i = -1
         Else
            i = 1
         End If
   End Select

   If fSortHiToLo Then i = -i
   SortCompare = i

End Function

Function GetRandom(iLo As Integer, iHi As Integer) As Integer

   GetRandom = Int(iLo + (Rnd * (iHi - iLo + 1)))

End Function


0
 
LVL 1

Author Comment

by:isidor
ID: 1446490
Thanks, Waty!
I'm sure those functions will come in handy.
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now