Link to home
Start Free TrialLog in
Avatar of mlcktmguy
mlcktmguyFlag for United States of America

asked on

Problems working with MultiDim Array

I want to store some values in a multi dimension array.

Each row should have 3 fields: TaxHeadID, TaxHeadIDCount and TaxHeadIDAmount

I wrote a routine that is passed the TaxHeadID and TaxHeadIDAmount.  The logic seemed simple but among other things I am tripping over Redim on multi dimension array.

The first thing the routine must do when it is called, is to check if the TaxHeadID is already in the array.  If it is, the TaxHeadIDCount is increaded by 1 and the passed amount is added to the TAXHeadIDAmount.

I am running into an immediate problem.  To check the array to determine if the TaxHEadID is already loaded I have to know the number of occorrences.  When I check this using the UBound function I get a subscript out of range error.

If the TAXHeadID is not already in the array a new occurrence must be added to the array.  In the new occurrence, the TAXHeadID will be loaded, the TAxHeadIDCount will be set to 1 and the TAXHeadIDAmount will be set to the passed value.
When I try to Redim the Array, either to add the create room for the first occurrence or add space for an additional occurrence I get an error, it tells me it is already dimensioned.

I’m pretty sure my logic is solid but I don’t know how to determine if I am trying to add the first item to an array, since my Ubound is giving me a subscript out of range.

I apparently don’t know how to Redim a mullti dimention array either.

I’ll include my code below.  Hopefully with the description I’ve give above and the code I’m showing below someone can advise on my issues.

Option Compare Database

Option Explicit

Option Base 1

Private Enum eTaxHeadCol
    eTaxHeadID = 1
    eTaxHeadCount = 2
    eTaxHeadTotal = 3
End Enum
'
Dim TaxHeadArr() As Double

Private Enum eTaxTACol
    eTaxHeadID = 1
    eTaxTAID = 2
    eTaxTATotal = 3
    eTaxTAPct = 3
End Enum
'
Dim TaxTAArr() As Double
'
Public Sub addToTaxHeadArray(passedHeadID As Long, _
                              passedNonCostAmt As Double)
'
Dim lookIdx As Long
Dim newIdx As Long
'
Dim foundIt As Boolean
foundIt = False
'
' Is it already in the table
'
If IsNull(TaxHeadArr) Then
    MsgBox ("It Is Null")
Else
    lookIdx = UBound(TaxHeadArr)
End If
lookIdx = UBound(TaxHeadArr, 2)
'
For lookIdx = 1 To UBound(TaxHeadArr, 2)
    If TaxHeadArr(eTaxHeadCol.eTaxHeadID, lookIdx) = passedHeadID Then
        TaxHeadArr(eTaxHeadCol.eTaxHeadCount, lookIdx) = TaxHeadArr(eTaxHeadCol.eTaxHeadCount, lookIdx) + 1
        TaxHeadArr(eTaxHeadCol.eTaxHeadTotal, lookIdx) = Round(TaxHeadArr(eTaxHeadCol.eTaxHeadTotal, lookIdx) + passedNonCostAmt, 2)
        foundIt = True
        Exit For
    End If
Next lookIdx
'
If foundIt Then
    Exit Sub
End If
'
' must add a new entry
'
newIdx = UBound(TaxHeadArr, 2) + 1
'
If newIdx = 1 Then
    ReDim TaxHeadArr(eTaxHeadCol.eTaxHeadTotal, newIdx) As Double
Else
    ReDim Preserve TaxHeadArr(eTaxHeadCol.eTaxHeadTotal, newIdx) As Double
End If
'
TaxHeadArr(eTaxHeadCol.eTaxHeadID, newIdx) = passedHeadID
TaxHeadArr(eTaxHeadCol.eTaxHeadCount, newIdx) = 1
TaxHeadArr(eTaxHeadCol.eTaxHeadTotal, newIdx) = passedNonCostAmt
'
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of crystal (strive4peace) - Microsoft MVP, Access
crystal (strive4peace) - Microsoft MVP, Access

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
don't feel too bad about being bitten by arrays -- they  confuse me too

Me Three...
;-)

When I get stuck, ...I typical skip the array and instead just store the values in a temp table..

Then you can use the normal lookup tools, something like this perhaps, to see if the TaxHeadID  already exists:
If DCount("YourField", "YourTable", "TaxHeadID=" & SomeValue)>1 Then
    'Do Something if TaxHeadID exists already
Else
    'Do something if TaxHeadID  does not exist,
    '...for example: YourCountValue=YourCountValue+1
end if

Open in new window

Code like this will use SQL to insert the value(s) into the temp table:
CurrentDB.execute "INSERT INTO YourTable (f1,f2,f3) Values(" & var1 & ", " & var2 & ", " & var3 & ")"

Open in new window


I may be off a bit on the syntax, ...but I think you get the idea,

To me, ...an array is just a temp table anyway, so I prefer to create an actual table anyway, ...this way I am not worrying about loosing anything when the code ends, ...or when things go out of scope.
It also makes it easier to "see" what is actually in the table, instead of relying on code.

To delete the temp table, then refresh the navigation pane:

   
 DoCmd.DeleteObject acTable, "TempTable"
    Application.RefreshDatabaseWindow

Open in new window


If I am not understanding something,...let me know...

JeffCoachman
Avatar of crystal (strive4peace) - Microsoft MVP, Access
crystal (strive4peace) - Microsoft MVP, Access

I agree with Jeff on the temp table ... and will add on

Access IS a database application and quite good at referencing tables ~

"To me, ...an array is just a temp table anyway, so I prefer to create an actual table anyway, ...this way I am not worrying about loosing anything when the code ends, ...or when things go out of scope.  It also makes it easier to "see" what is actually in the table, instead of relying on code."

agree!

Best, however, not to make temp tables in your working database.  Since you are using code, make it with code ... somewhere else
   '---------------------- create a new database
   dim sPathFileDatabase as string 

   sPathFileDatabase = CurrentProject.Path & "\ReportDatabase.accdb"  '---- CUSTOMIZE THIS

   'make a blank database
   DBEngine.CreateDatabase sPathFileDatabase, dbLangGeneral

Open in new window

When you are using Make Table and Append queries, you can use the optional IN clause to specify the path and filename of an external database. For instance, modifying what Jeff gave you:
   dim db as dao.database

   dim sSQL as string

   set db = CurrentDb
   sSQL = ""INSERT INTO YourTable (f1,f2,f3) " _
         & " IN 'C:\folder\MyDatabase.accdb' " _
         & " Values(" & var1 & ", " & var2 & ", " & var3 & ")" _
         & " ORDER BY [whatever];"

   with db
      .execute sSql
      msgbox .RecordsAffected & " records affected",,"Done appending"
   end with
   set db = nothing

Open in new window


when you change the table to a Make-Table query and are prompted for the tablename, you can specify it to be in another database so you can use the designer also

After a make-table query, you would then want to link to the table:

   
'---------------------- link to a table in another database

   dim sPathFileDatabase as string _
      , sTablename as string

   dim db as dao.database _
      , tdf as dao.tabledef

   sPathFileDatabase = "c:\folder\databasename.accdb"    '---- CUSTOMIZE THIS
   sTablename = "Name of table"                          '---- CUSTOMIZE THIS

   'set db to be the current database
   set db = currentdb

   'if table is already there, delete it
   call DropTheTable(sTablename)

   'link to table
   With db 
      Set tdf = .CreateTableDef(sTablename)
      tdf.Connect = ";Database=" & sPathFileDatabase
      tdf.SourceTableName = sTablename
      .TableDefs.Append tdf
      .TableDefs.Refresh
   End With

   'release object variables
   set tdf = nothing
   set db = nothing

Open in new window



WHERE
sPathFileDatabase is the path and file to your database
sTablename is the name of the table to link to

and here is code to drop a table:
Public Sub DropTheTable( _
   pdb As DAO.Database _
   , sTablename As String _
   )
'150821 s4p
'deletes a table from the passed database reference
'if the table is not there to delete, no error will be returned

    Dim sName As String
   
    On Error GoTo Proc_Err
   
    'See if the table is there
    sName = pDb.TableDefs(sTablename).Name
   
    'If no error then table is there -- delete it
    With pdb
      .Execute "DROP TABLE [" & sTablename & "];"
      .TableDefs.Refresh
   End With
   DoEvents
      
   
Proc_Exit:
   On Error Resume Next
    Exit Sub
   
Proc_Err:

    Select Case Err.Number
      Case 3265 'Table does not exist
      Case Else
         MsgBox Err.Description, , _
           "ERROR " & Err.Number _
           & "   DropTheTable"
   End Select
   
   Resume Proc_Exit
   Resume
   
End Sub

Open in new window

<I apparently don’t know how to Redim a mullti dimention array either.>

well, this will probably get you started  Redim Statement
Avatar of mlcktmguy

ASKER

Thanks for the responses and interest in my question.  There are some really great ideas for alternatives to the dreaded multi-dimensional array.

As background: my primary reason for using an array is processing speed.  In the past I have used temp tables to address this situation and they work perfectly but I am trying to eliminate I/O in this particular process.

Prior to my post I read the 'ReDim' documentation several times, which led to how I set up the Redims currently flagged in error.  I read it again at Roy Obrero's suggestion but I still don't see my issue.

I would still like to know:

1. How the original Dim should look for an array to be used as I intend.

2. How I can determine if a multi-dim array has any contents.  To know if this is the first Redim or I want to ReDim Preserve to retain any prior contents.

3. The correct format of the ReDim to increase the size of the array to add a new occurrence.

If no EEer's have answers the above then I will adopt Crystal's first solution to make all of the columns there own one dimensional array but I would really like to understand the multi appoach
1. you are using different data types so I think you need to use 3 single dimension arrays.  Why might you use a multi? An example might be that you are a teacher and have several classes.  In each class you have several students, and each student takes several tests.  So you might do an array for all the test scores with the dimensions being class, student, and test number.

2.
dim iCounter as integer
iCounter  = 0
'initalize each array
redim preserve adblTaxHeadID(iCounter ) 
redim preserve alngTaxCount(iCounter ) 
redim preserve acurTaxHeadIDAmount (iCounter ) 

Open in new window


3.
'increment array counter
iCounter = iCounter + 1
redim preserve adblTaxHeadID(iCounter ) 
redim preserve alngTaxCount(iCounter ) 
redim preserve acurTaxHeadIDAmount (iCounter ) 

Open in new window

I definitely see your point, in fact I am converting the routine in that direction right now to see if I can get it to work.

I am still running into an issue with determining whether anything has been loaded into the array yet.

my array definition is
Dim TaxHeadArr() As Double

When the routine is called I want to know if the array has any contents to know whether I need to Redim or Redim Preserve.

I have tried
LBound(TaxHeadArr) and UBound(TaxHeadArr) but they both throw a 'subscript out of range error'.
if lbound or ubound throws an error, then nothing is in the array yet ...

so if you are dimensioning the array at the top of the module, also dim the counter.  Initialize the counter to -1 and test that.
Although not multi dimensional, this is the approach I used to finish this routine.  Here is the finished product.

Option Compare Database

Option Explicit

Option Base 1
'
Dim TaxHeadIDArr() As Long
Dim TaxHeadCountArr() As Long
Dim TaxHeadTotalArr() As Double
'
Public Sub addToTaxHeadArray(passedHeadID As Long, _
                             passedNonCostAmt As Double, _
                             Optional passedClearArrayFirst As Boolean = False)
'
Dim currSize As Long
Dim lookIdx As Long
Dim newIdx As Long
'
Dim foundIt As Boolean
'
currSize = 0
'
On Error Resume Next
currSize = UBound(TaxHeadIDArr)
On Error GoTo 0
'
foundIt = False
'
If passedClearArrayFirst Or currSize = 0 Then    ' either we want to clear it or it's empty, no sense looking
Else
    '
    For lookIdx = 1 To currSize
        If TaxHeadIDArr(lookIdx) = passedHeadID Then
            TaxHeadCountArr(lookIdx) = TaxHeadCountArr(lookIdx) + 1
            TaxHeadTotalArr(lookIdx) = Round(TaxHeadTotalArr(lookIdx) + passedNonCostAmt, 2)
            foundIt = True
            Exit For
        End If
    Next lookIdx
End If
'
If foundIt Then
    Exit Sub
End If
'
' must add a new entry
'
If passedClearArrayFirst Or currSize = 0 Then      ' either the array was never loaded or we want to start the array over
    newIdx = 1
    ReDim TaxHeadIDArr(newIdx) As Long
    ReDim TaxHeadCountArr(newIdx) As Long
    ReDim TaxHeadTotalArr(newIdx) As Double
Else
    newIdx = UBound(TaxHeadIDArr) + 1
    ReDim Preserve TaxHeadIDArr(newIdx) As Long
    ReDim Preserve TaxHeadCountArr(newIdx) As Long
    ReDim Preserve TaxHeadTotalArr(newIdx) As Double
   
End If
'
TaxHeadIDArr(newIdx) = passedHeadID
TaxHeadCountArr(newIdx) = 1
TaxHeadTotalArr(newIdx) = passedNonCostAmt
'
End Sub
as long as you are using Option Base 1, this should work.  Although instead of forcing an error, I would have also put newIdx at the module level.  You also don't need foundIt, which seems to be assigned but not used. Anyway, newIdx will be 0 if it hasn't been redimmed and you wouldn't need currSize = 0 since, once again, you can test newIdx.

happy you got something that works though ~