Results 1 to 8 of 8
  1. #1
    Join Date
    Nov 2003
    Posts
    104

    Unanswered: VBA Algorithm problem

    Hi all,
    I am trying to figurre out an algorithm that works with an array. Any help would be greatly appreciated. I have an array of integers that looks something like this:

    1 2 3 3 -1 -1 -1 -1 -1 -1 [10 elements]

    Note, that this array will ALWAYS have 10 elements (fixed size array). Also note, the -1s are NOT necessarily together. So you could have something like -1 8 3 2 -1 etc...

    Here is what I need

    I need an algorithm that will make a new array out of this one but with the following criteria

    1.) Remove any repititions. (in the example above, the 2 3s should be made into 1)

    2.) Discard any -1s.

    So the NEW array should look like

    1 2 3 [3 elements]


    The reason I am doing this Is I have 10 combo boxes, and I would like to remove any repitions and "empty/null" values from the list of their indices so I can update 2 tables in a database!

    Any help would be greatly appreciated. Thanx beforehand

  2. #2
    Join Date
    Feb 2002
    Posts
    2,232
    The logic will consist of a couple for..next loops using the smaller list as the loop comparison. I am debating on whether or not using a recordset object would be easier for you to manipulate. I will test it out and reply later.

  3. #3
    Join Date
    Nov 2003
    Posts
    104
    A recordset will not do. You see what I have is 10 combo boxes. And anywhere from 0 to 10 of them could hold values. The ones that do NOT hold values are represented as -1 in an integer array. The ones that DO hold values may be repettive. Like you can have two combo boxes with the same value. My aim is to create an array that actually rpresents everything without repitions so I can update tables in a database!

  4. #4
    Join Date
    Apr 2002
    Location
    Germany
    Posts
    228
    EDIT: oh, do you want to keep out ANY duplicates? this below only works to duplicates than are following directly after another

    Here's something I just worked out.
    It uses 2 passes as it's not too good of an idea to redim a dynamic array within a loop for performance reasons. Although in this case with 10 elements you probably won't notice the difference

    Code:
    Public Sub NoDuplicatesTest()
    
        Dim ar1(0 To 9) As Long
        Dim ar2() As Long
        
        Dim i As Long
        
        ar1(0) = 1
        ar1(1) = 2
        ar1(2) = 3
        ar1(3) = 3
        ar1(4) = -1
        ar1(5) = -1
        ar1(6) = -1
        ar1(7) = -1
        ar1(8) = -1
        ar1(9) = -1
        
        NoDuplicates ar1, ar2
        
        For i = LBound(ar2) To UBound(ar2)
        
            Debug.Print ar2(i)
        
        Next i
    
    End Sub
    
    Public Sub NoDuplicates(ByRef SourceArr() As Long, ByRef DestArr() As Long)
    
        Dim i As Long
        Dim Count As Long
        Dim OldValue As Long
        
        Count = 0
        OldValue = -1
        
        'Step 1, determine new element count
        For i = LBound(SourceArr) To UBound(SourceArr)
        
            If SourceArr(i) <> OldValue And SourceArr(i) <> -1 Then
            
                Count = Count + 1
            
            End If
            
            OldValue = SourceArr(i)
        
        Next i
    
        ReDim DestArr(0 To Count - 1)
        
        Count = 0
        OldValue = -1
        
        'Step 2, fill array
        For i = LBound(SourceArr) To UBound(SourceArr)
        
            If SourceArr(i) <> OldValue And SourceArr(i) <> -1 Then
            
                DestArr(Count) = SourceArr(i)
                Count = Count + 1
            
            End If
            
            OldValue = SourceArr(i)
        
        Next i
    
    End Sub
    Last edited by Apel; 12-11-03 at 06:17.

  5. #5
    Join Date
    Apr 2002
    Location
    Germany
    Posts
    228
    ok, here's another try. basically the same idea with the 2 passes but to check for duplicates we use a collection which has some nice things for us here.
    1. Adding an item is a lot faster than using redim preserve on an array
    2. It offers a nice way for detecting duplicate values via the key for an item. We aren't actually interested in the values that are stored but the keys. The collection hashes this key and uses it to access the items. Thus to access an item again it doesn't have to traverse all items. As the collection checks for the duplicate key before adding we can abuse this to detect the duplicates.

    Code:
    Public Sub NoDuplicatesTest()
    
        Dim ar1(0 To 9) As Long
        Dim ar2() As Long
        
        Dim i As Long
        
        ar1(0) = 1
        ar1(1) = 2
        ar1(2) = 3
        ar1(3) = 3
        ar1(4) = -1
        ar1(5) = 3
        ar1(6) = 1
        ar1(7) = 2
        ar1(8) = -1
        ar1(9) = 4
        
        NoDuplicates ar1, ar2
        
        For i = LBound(ar2) To UBound(ar2)
        
            Debug.Print ar2(i)
        
        Next i
    
    End Sub
    
    Public Sub NoDuplicates(ByRef SourceArr() As Long, ByRef DestArr() As Long)
    
        Dim i As Long
        Dim UniqueValues As Collection
        Dim Count As Long
        Dim CurrentValue As Long
        
        'Step 1, determine new element count
        Count = 0
        Set UniqueValues = New Collection
        For i = LBound(SourceArr) To UBound(SourceArr)
       
            CurrentValue = SourceArr(i)
            
            If CurrentValue <> -1 Then
                
                On Error Resume Next
                UniqueValues.Add CurrentValue, Str(CurrentValue)
                If Err.Number = 0 Then
                    Count = Count + 1
                End If
                On Error GoTo 0
            
            End If
            
        Next i
        Set UniqueValues = Nothing
       
        ReDim DestArr(0 To Count - 1)
        
        'Step 2, fill array
        Count = 0
        Set UniqueValues = New Collection
        For i = LBound(SourceArr) To UBound(SourceArr)
       
            CurrentValue = SourceArr(i)
            
            If CurrentValue <> -1 Then
            
                On Error Resume Next
                UniqueValues.Add CurrentValue, Str(CurrentValue)
                If Err.Number = 0 Then
                    DestArr(Count) = CurrentValue
                    Count = Count + 1
                End If
                On Error GoTo 0
            
            End If
            
        Next i
        Set UniqueValues = Nothing
        
    End Sub

  6. #6
    Join Date
    Nov 2003
    Posts
    104
    OK I got this to work, Here is a fragment of my code (for future reference)

    Code:
    Private Sub cmdUpdate_Click()
    
    'SOME CODE GOES HERE
    'SOME CODE GOES HERE
    'SOME CODE GOES HERE
    'SOME CODE GOES HERE
    
    For x = 1 To 10
        
            val = Me("cmbobxGroup" & CStr(x)).Value
            If (val <> "") Then
                DropDowns(x) = CInt(val)
            Else
                DropDowns(x) = -1 '-1 indicates a null or empty value
            End If
            
        Next x
       
        Dim search_result As Boolean
        search_result = False 'default to false
       
       ActualArray(0) = -99 'manually foce the first item not to be 0
       
        For x = 1 To 10
            
                search_result = SearchArray(ActualArray, DropDowns(x))
                
                If ((DropDowns(x) <> -1) And (search_result = False)) Then
                    Call AddToArray(ActualArray, DropDowns(x))
                End If
            
        Next x
       
        'THE FOLLOWING CODE REMOVES THE EXTRA 0
        'AT THE END OF THE ARRAY
        'START BLOCK
        Dim bound As Integer
        bound = UBound(ActualArray)
        If (ActualArray(bound) = 0) Then
            ReDim Preserve ActualArray(0 To bound - 1)
        End If
        'END BLOCK
    
         'MORE CODE GOES HERE
         'MORE CODE GOES HERE
         'MORE CODE GOES HERE
    
    End Sub
    
    
    Private Function SearchArray(A() As Integer, findme As Integer) As Boolean
    Dim found As Boolean
    found = False 'default found to false
    For x = 1 To UBound(A)
    
        If (A(x) = findme) Then
            found = True
            SearchArray = found 'get ready to return this value
            Exit Function 'once its found, no need to loop again. Just exit
        
        End If
        
    Next x
    
    SearchArray = found 'get ready to return this value
    End Function
    
    Private Function AddToArray(ByRef A() As Integer, addme As Integer)
        
       Dim bound As Integer
       bound = UBound(A)
       
       A(bound) = addme
       ReDim Preserve A(0 To bound + 1)
        
    End Function

    Note that DropDowns is the array of size 10 (that contains the 12 integers).


    Also note, I added a block of code (bolded) to remove the 0 at the end of the array!


    Note: This is NOT the most efficient way to do this. The function SearchArray Gets called 10 times, and in each time, it has UP TO 10 loops (meaning a maximum of 100 steps). This algorithm above WORKS but it could use some serious tweaking.

    Can Anyone offer insight how to make the code above cleaner and more efficient and (hopefully) not as ugly (i mean SearchArray gets called 10 times, with a maximum of 100 steps!)
    Last edited by shassouneh; 12-11-03 at 14:42.

  7. #7
    Join Date
    Oct 2003
    Posts
    706

    Cool

    Simple solution: turn the problem sideways!

    Let's say that there are, oh, twenty possible values that any combo-box value could possibly take (in addition to "no value", which is represented by -1). So the real statement of your problem is: Which of these possible values actually occur at least one time in the input?

    Thus: you set up an array of Logical (yes/no) initialized to all-False. (This list can be resizeable of course.) Then scan the input:

    Code:
      for n = 1 to whatever
        if input_list[n] <> -1 then occurs[input_list[n]] = True
      next n
    ...
    When generating the SQL string, simply consider only the values where occurs[n] = True.

    Specifically referencing your original statement of the problem: upon completion of the loop, occurs[1], occurs[2], and occurs[3] would be True and the others would be False, if given an input such as "1 2 3 3 -1 -1 -1 -1 -1 -1."
    Last edited by sundialsvcs; 12-11-03 at 14:59.
    ChimneySweep(R): fast, automatic
    table repair at a click of the
    mouse! http://www.sundialservices.com

  8. #8
    Join Date
    Apr 2002
    Location
    Germany
    Posts
    228
    Originally posted by sundialsvcs
    Let's say that there are, oh, twenty possible values that any combo-box value could possibly take (in addition to "no value", which is represented by -1). So the real statement of your problem is: Which of these possible values actually occur at least one time in the input?
    well, this only holds true as long as the data from the rowsource in these combo-boxes is truely static and not lets say a list of invoices or whatever.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •