Solved

Problem in charging a bi_dim array

Posted on 2002-07-21
8
219 Views
Last Modified: 2010-05-02
Kind all,
        I am facing this problem when charging the ArrMyArray Array within a RS loop.
what happen is the following: lets say I have the following values x the 1 record:
(lets suppose for semplicity I have just 2 records)

DB_FIELD1 = "ccc"; DB_FIELD2 = "ff;cc"; RS!DB_FIELD3 = "nn;jj"

DB_FIELD1 = "cc"; DB_FIELD2 = "bb;gg"; RS!DB_FIELD3 = "xx;rr"

In this case the array gets loaded ok,

BUT if in the 2 record I have a thing as:

DB_FIELD1 = "cc"; DB_FIELD2 = "bb"; RS!DB_FIELD3 = "xx"

where for the fields DB_FIELD2 and RS!DB_FIELD3  I have a DIFFERENT number of elements separed by ";" - here just 1 - than the other - there 2 elements - I get a subscript out of range error when loading the array.

Any help is sooooo welcome!!






While Not RS.EOF
           
            Set RS = DalBdg.ExecuteSelect()
                       
            str1 = CStr(RS!DB_FIELD1)
            str2 = CStr(RS!DB_FIELD2)
            str3 = CStr(RS!DB_FIELD3)
                   
            Arrstr1 = Split(str1, ";")
            Arrstr2 = Split(str2, ";")
            Arrstr3 = Split(str3, ";")
                     
            Dim counter1 As Integer
            Dim counter2 As Integer
            Dim counter3 As Integer
           
            Dim arrCount As Integer
   
            arrCount = (UBound(Arrstr1) + 1) * (UBound(Arrstr2) + 1) * (UBound(Arrstr3) + 1)
           
            ReDim Preserve ArrMyArray(arrCount, 3)
                    arrCount = 0
                    For counter1 = 0 To UBound(Arrstr1)
                      For counter2 = 0 To UBound(Arrstr2)
                        For counter3 = 0 To UBound(Arrstr3)
                          arrContesto_Utente(arrCount, 0) = Arrstr1(counter1)
                          arrContesto_Utente(arrCount, 1) = Arrstr2(counter2)
                          arrContesto_Utente(arrCount, 2) = Arrstr3(counter3)
                          arrCount = arrCount + 1
                        Next
                      Next
                    Next
            RS.MoveNext
        Wend

0
Comment
Question by:wwboy
  • 6
  • 2
8 Comments
 
LVL 17

Expert Comment

by:inthedark
ID: 7168206
Strange?

While Not RS.EOF ' this does not exists yet?
         
    Set RS = DalBdg.ExecuteSelect() ' this would recreate the same data


Looks like you could be looping......

Also:

ReDim Preserve ArrMyArray(arrCount, 3) ' is not allowed

as you can only chanmge theouter most ubound in a multi-dimensional array.

Try changing your logical array meaning so that you can say:

ReDim Preserve ArrMyArray(3, ArrayCount)

This may not have resolved all of the problems....
0
 
LVL 17

Expert Comment

by:inthedark
ID: 7168358
Further:


           arrCount = (UBound(Arrstr1) + 1) * (UBound(Arrstr2) + 1) * (UBound(Arrstr3) + 1)
           
           ReDim Preserve ArrMyArray(3, arrCount)
                   arrCount = 0
                   For counter1 = 0 To UBound(Arrstr1)
                     For counter2 = 0 To UBound(Arrstr2)
                       For counter3 = 0 To UBound(Arrstr3)
                         'arrContesto_Utente(arrCount, 0)
= Arrstr1(counter1)
'Change to
                         arrContesto_Utente(0,arrCount)
= Arrstr1(counter1)


                         arrContesto_Utente(1,arrCount) = Arrstr2(counter2)

etc....
0
 
LVL 17

Expert Comment

by:inthedark
ID: 7168370
Also suggest that you are looping with no purpose, as with each loop you are clearing you array without doing anything withit.

So if you want to load all values from all records you may need some changes:

Dim counter1 As Integer
Dim counter2 As Integer
Dim counter3 As Integer
Dim arrCount As Integer

ReDim ArrMyArray(3, 0)

Set RS = DalBdg.ExecuteSelect()
arrCount = -1
While Not RS.EOF
                       
           str1 = CStr(RS!DB_FIELD1)
           str2 = CStr(RS!DB_FIELD2)
           str3 = CStr(RS!DB_FIELD3)
                   
           Arrstr1 = Split(str1, ";")
           Arrstr2 = Split(str2, ";")
           Arrstr3 = Split(str3, ";")
                   
 
           

                   For counter1 = 0 To UBound(Arrstr1)
                     For counter2 = 0 To UBound(Arrstr2)
                       For counter3 = 0 To UBound(Arrstr3)
                         arrCount = arrCount + 1
 
                         if arrCount> Ubound(ArrMyArray,2) Then
                           Redim Preserve ArrMyArray(3, arrCount + 100)' +100 for speed
                         end if
                         ArrMyArray(0, arrCount) = Arrstr1(counter1)
                         ArrMyArray(1, arrCount) = Arrstr2(counter2)
                         ArrMyArray(2, arrCount) = Arrstr3(counter3)
                         Next
                     Next
                   Next
           RS.MoveNext
       Wend


' Now you have all in ArrMyArray

Redim Preserve ArrMyArray(3, arrCount)

Hope this helps......
0
Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

 
LVL 17

Expert Comment

by:inthedark
ID: 7168377
And now I see that you are adding str1 & str2 multiple times I suspect that this may not be required. Suggest the following:

Dim counter1 As Integer
Dim counter2 As Integer
Dim counter3 As Integer
Dim arrCount As Integer

ReDim ArrMyArray(3, 0)

Set RS = DalBdg.ExecuteSelect()
arrCount = -1
While Not RS.EOF
    Arrstr1 = Split(CStr(RS!DB_FIELD1), ";"):Gosub AddToArray
    Arrstr1 = Split(CStr(RS!DB_FIELD2), ";"):Gosub AddToArray
    Arrstr1 = Split(CStr(RS!DB_FIELD3), ";"):Gosub AddToArray

    RS.MoveNext
Wend

' Now you have all in ArrMyArray

Redim Preserve ArrMyArray(3, arrCount)

etc......

AddToArray:

For counter1 = 0 To UBound(Arrstr1)
  arrCount = arrCount + 1
  if arrCount> Ubound(ArrMyArray,2) Then
    Redim Preserve ArrMyArray(3, arrCount + 100)' + 100 or more for speed
  end if
  ArrMyArray(0, arrCount) = Arrstr1(counter1)
Next

Return


Hope this helps......
0
 
LVL 17

Expert Comment

by:inthedark
ID: 7168384
Getting smaller but now too small:

Dim counter1 As Integer
Dim counter2 As Integer
Dim counter3 As Integer
Dim arrCount As Integer

ReDim ArrMyArray(2, 0)

Set RS = DalBdg.ExecuteSelect()
arrCount = -1
While Not RS.EOF
   px=0:Arrstr1 = Split(CStr(RS!DB_FIELD1), ";"):Gosub AddToArray
   px=1:Arrstr1 = Split(CStr(RS!DB_FIELD2), ";"):Gosub AddToArray
   px=2:Arrstr1 = Split(CStr(RS!DB_FIELD3), ";"):Gosub AddToArray

   RS.MoveNext
Wend

' Now you have all in ArrMyArray

Redim Preserve ArrMyArray(3, arrCount)

etc......

AddToArray:

For counter1 = 0 To UBound(Arrstr1)
 arrCount = arrCount + 1
 if arrCount> Ubound(ArrMyArray,2) Then
   Redim Preserve ArrMyArray(3, arrCount + 100)' + 100 or more for speed
 end if
 ArrMyArray(PX, arrCount) = Arrstr1(counter1)
Next

Return

I think you may be better to change the structure of the array, but I don't know what you need it for.

Like:

ReDim ArrMyArray(1, 0)
etc....


AddToArray:

For counter1 = 0 To UBound(Arrstr1)
 arrCount = arrCount + 1
 if arrCount> Ubound(ArrMyArray,2) Then
   Redim Preserve ArrMyArray(1, arrCount + 100)' + 100 or more for speed
 end if
 ArrMyArray(0, arrCount) = PX
 ArrMyArray(1, arrCount) = Arrstr1(counter1)
Next

Return
0
 

Author Comment

by:wwboy
ID: 7168959
plz inthedark, try to correct this.
Plz don't send new code :)

While Not RSAuthCodes.EOF
           
            Set RSTriplets = DalBdg.ExecuteSelect("BDG_AUTORIZZAZIONI", strFieldNsmes, _
            "COD_AUTORIZZAZIONE = '" & RSAuthCodes!COD_AUTORIZZAZIONE & "'", strCnstring, _
            DBG_SEVERITYLOG, EnumEveServ, ErrorMessage, _
            DBG_FILE_LOG, DBG_LOGMAXSIZE, DBG_DIRWORK)
           
            'se ci sono stati errori nella ExecuteSelect esco
            If ErrorMessage <> "" Then
               ErrorMessage = ErrorMessage
               Login = arrContesto_Utente
               Exit Function
            End If
'
'            'per ciascuna tripletta trovata vado a caricare il mio array bi-dim
'            'x comodità salvo in variabili locali
            COD_ATTIVITA = CStr(RSTriplets!COD_ATTIVITA)
            VALORE_ATTIVITA = CStr(RSTriplets!VALORE_ATTIVITA)
            ELENCO_CDR = CStr(RSTriplets!ELENCO_CDR)

            ArrCOD_ATTIVITA = Split(COD_ATTIVITA, ";")       'ARRAY COD_ATTIVITA
            ArrVALORE_ATTIVITA = Split(VALORE_ATTIVITA, ";") 'array VALORE_ATTIVITA
            ArrELENCO_CDR = Split(ELENCO_CDR, ";")           'ARRAY ELENCO_CDR
'
           
            'prodotto cartesiano
            If counterX > 0 Then
              arrCount = (UBound(arrContesto_Utente, 1) + ((UBound(ArrCOD_ATTIVITA) + 1) * (UBound(ArrVALORE_ATTIVITA) + 1) * (UBound(ArrELENCO_CDR) + 1)))
            Else
              arrCount = 1 + (UBound(ArrCOD_ATTIVITA) + 1) * (UBound(ArrVALORE_ATTIVITA) + 1) * (UBound(ArrELENCO_CDR) + 1)
            End If
           
            If counterX > 0 Then
              arrIndex = UBound(arrContesto_Utente, 1) + 1
            Else
              arrIndex = 1
            End If
           
           
            ReDim Preserve arrContesto_Utente(arrCount, 3)

                    For counter1 = 0 To UBound(ArrCOD_ATTIVITA)
                      For counter2 = 0 To UBound(ArrVALORE_ATTIVITA)
                        For counter3 = 0 To UBound(ArrELENCO_CDR)

                          arrContesto_Utente(arrIndex, 0) = ArrCOD_ATTIVITA(counter1)
                          arrContesto_Utente(arrIndex, 1) = ArrVALORE_ATTIVITA(counter2)
                          arrContesto_Utente(arrIndex, 2) = ArrELENCO_CDR(counter3)
                          arrIndex = arrIndex + 1
                         
                        Next
                      Next
                    Next
            counterX = counterX + 1
           
            RSAuthCodes.MoveNext
        Wend
0
 

Author Comment

by:wwboy
ID: 7168961
Please do just some close interventions! :)
0
 
LVL 17

Accepted Solution

by:
inthedark earned 300 total points
ID: 7169067
You may only redim preserve the outmost bound:

ReDim Preserve arrContesto_Utente(arrCount, 3) ' is not allowed.

ReDim Preserve arrContesto_Utente(3, arrCount) ' would be allowed

So you would need to swap the array params arround everywhere used.



0

Featured Post

Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Access 2016 VB code 9 115
VBA/SQL - Connect to SQL server and pull data 4 107
Protecting vb6 & .Net code Obfuscation 18 121
Problem to With line 4 57
I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
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…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

813 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

14 Experts available now in Live!

Get 1:1 Help Now