MultiDimensional Array Issues (1 Viewer)

[MrBen101]

Afternoon All!

I really need your help with this one, been going round in circles for ages now!

I've got a DB which simulates future waiting lists. This works absolutely fine, it's just extremely slow, 15 minutes to complete process. What I need to do is change from the SQL statements I use to an array. This is so that all of the calculations are done in memory instead of being written back to the DB all the time.

Only problem is I don't know anything about arrays. I've had a go and I can get the first record of the recordset into my array, but that's it, I can't get the next record in there. It's really frustrating now!

Here's the code I have so far:

Dim DB As Database
Dim rst As Recordset
Dim X, Y, Z As Integer
Dim SID As Integer
Dim WeekY As Integer
Dim Pats As Integer
Dim NoToRemove As Integer
Dim NoToAdd As Integer
Dim myRemove As Recordset
Dim myAdd As Recordset
Dim myValue As Recordset
Dim myValue2 As Recordset
Dim myValue3 As Recordset
Dim NewValue
Dim NewValue2
Dim NewValue3
Dim MyNewValue
Dim sqlMakeTable As String
Dim sqlRemove As String
Dim sqlAdd As String
Dim sqlNewValue As String
Dim sqlNewValue2 As String
Dim sqlNewValue3 As String
Dim ProgAmount As Integer
Dim RetVal As Variant
Dim varArray() As Integer
Dim S As String
Dim intArrayCount As Integer
Dim intArrayCount2 As Integer
Dim intCounter As Long
 
 
    sqlMakeTable = "SELECT tbl1stAttempt.[Weeks Waited], tbl1stAttempt.[Patients Waiting], tbl1stAttempt.Spec_ID, " _
        & "tbl1stAttempt.WeeksSinceApr06, tbl1stAttempt.Spec_Code, tbl1stAttempt.Spec_Desc INTO tblTemp" _
        & " FROM tbl1stAttempt, qryMaxWeek " _
        & "WHERE (((tbl1stAttempt.[Weeks Waited]) = 0) And ((tbl1stAttempt.Spec_ID) = 3) And ((tbl1stAttempt.WeeksSinceApr06) = 52))" _
        & "ORDER BY tbl1stAttempt.[Weeks Waited] DESC;"
     
    DoCmd.SetWarnings False
        DoCmd.RunSQL sqlMakeTable
        DoCmd.RunSQL ("DELETE * FROM tblTemp")
    DoCmd.SetWarnings True
     
    ProgAmount = 1
    RetVal = SysCmd(acSysCmdInitMeter, "Simulating Waiting List.....", 11077)
     
    Set DB = CurrentDb
    Set rst = DB.OpenRecordset("tbl1stAttempt")
    
    intArrayCount = 0
    intCounter = 0
    
    ReDim Preserve varArray(0 To 3, 0 To intArrayCount)
    
    SID = rst![Spec_ID]
    X = rst![Weeks Waited]
    WeekY = rst![WeeksSinceApr06]
    Pats = rst![Patients Waiting]
     
     
    
    intArrayCount = 0
    intCounter = 0
    With rst
        .MoveLast
        .GetRows
        .MoveFirst
         Do Until rst.EOF
            varArray(0, intArrayCount) = X
            varArray(1, intArrayCount) = Pats
            varArray(2, intArrayCount) = WeekY
            varArray(3, intArrayCount) = SID
    
            ReDim Preserve varArray(0 To 3, intArrayCount + 1)
    
            For intCounter = 0 To 3
                Debug.Print varArray(intCounter, intArrayCount)
    
            Next intCounter
    
            intArrayCount = intArrayCount + 1
    
            .Move 1
    
        Loop
    
        .Close
    
    End With

I've got a lot of things DIM's up there because this is part of a large DB, I just need a little kick in the right direction to get the ole' brain working again. Haven't used Arrays for 8 years so I've completely forgotten everything to do with them. I've read everything I can find on this forum and many others but I just don't understand it now. Must be my old age.

Any help you could offer would be greatly appreciated!

Kind regards,

Ben

 

[chergh]

yourArray = rst.getrows()

 

[MrBen101]

Hello there, that was a speedy reply, thanks!

yourArray = rst.getrows()

I've got that in there already

With rst
        .MoveLast
        .GetRows
        .MoveFirst

Doesn't appear to work, just gives me the first record from the table

I need to get the info into the array, then perform various calculations on the information, save it back to the array, then dump it out to a table at the end.

That definately is possible isn't it?

I hope so!

 

[DJkarl]

Just an FYI, VBA dim statements like

Dim X, Y, Z As Integer

Will results in Z being an integer, and X and Y being variants. If this is what you wanted then good, but if you wanted these all to be integers you would need to put

Dim X As Integer, Y As Integer, Z As Integer

 

[chergh]

I don't use arrarys in access that much, use them a lot more in excel, so I might be missing something but it looks as though you are trying to loop through the recordset and assign a value to each element of the array one record at the time. Instead of this looping you should be able to get rid of all that code and simply use my suggestion above which should dump your entire recordset into the array.

 

[MrBen101]

Unfortunately I need to loop through the records one at a time to perform the calculations. Would it be better to get the records into the array first then calculate on them?

 

[chergh]

yes, I would create the array first then do the required calculations

 

[twoplustwo]

Hi Che,

Just a quickie in relation to this.

What variable type do you set the array to to dump a recordset in there?

 

[chergh]

Variant is probably going to be easiest, you could probably use string as well though I can't remember if this causes issues when you have numeric and date fields.

 

[twoplustwo]

Ah, thanks. It's working, I'll have a play (I have a date column).

Cheers again.

 

[MrBen101]

Ok, I've got my array now, fully populated et al.

 Set DB = CurrentDb
    Set rst = DB.OpenRecordset("tbl1stAttempt")
 
    intArrayCount = 0
    intCounter = 3
    intArrayCount2 = rst.RecordCount
 
    varArray = rst.GetRows(intArrayCount2)
 
    rst.MoveFirst

How do I perform calculations on an array though? Please bear in mind that when it comes to this I have the mental ability of a 3 year old.

The code I need to convert from SQL to array is:

    For SID = 1 To 19
 
        For WeekY = 53 To 64
 
            sqlRemove = "SELECT [Patients_To_Remove]" _
                & "FROM [tbl_Patients_To_Remove]" _
                & "WHERE [WeeksSinceApril06] = " & WeekY & " And [Specialty_Code] = " & SID
 
            Set myRemove = CurrentDb.OpenRecordset(sqlRemove, dbReadOnly)
            NoToRemove = myRemove![Patients_To_Remove]
 
            sqlAdd = "SELECT [Patients_To_Add]" _
                & "FROM [tbl_Patients_To_Remove]" _
                & "WHERE [WeeksSinceApril06] = " & WeekY & " AND [Specialty_Code] = " & SID
 
            Set myAdd = CurrentDb.OpenRecordset(sqlAdd, dbReadOnly)
            NoToAdd = myAdd![Patients_To_Add]
 
                For X = 50 To 0 Step -1
 
                    If X = 52 Then
 
                           sqlNewValue = "SELECT [Patients Waiting]" _
                            & " FROM tbl1stAttempt" _
                            & " WHERE [Weeks Waited] = 52 AND [WeeksSinceApr06] = " & WeekY - 1 & " AND [Spec_ID] = " & SID
                        Set myValue = CurrentDb.OpenRecordset(sqlNewValue, dbOpenDynaset)
 
                        sqlNewValue2 = "SELECT [Patients Waiting]" _
                            & " FROM tbl1stAttempt" _
                            & " WHERE [Weeks Waited] = 51 AND [WeeksSinceApr06] = " & WeekY - 1 & " AND [Spec_ID] = " & SID
                        Set myValue2 = CurrentDb.OpenRecordset(sqlNewValue2, dbOpenDynaset)
 
                        NewValue = myValue![Patients Waiting]
                        NewValue2 = myValue2![Patients Waiting]
 
                        MyNewValue = NewValue + NewValue2
 
                    ElseIf X = 0 Then
 
                        MyNewValue = NoToAdd
 
                    Else:
 
                        sqlNewValue3 = "SELECT [Patients Waiting]" _
                            & " FROM tbl1stAttempt" _
                            & " WHERE [Weeks Waited] = " & X - 1 & " AND [WeeksSinceApr06] = " & WeekY - 1 _
                            & " AND [Spec_ID] = " & SID
                        Set myValue3 = CurrentDb.OpenRecordset(sqlNewValue3, dbOpenDynaset)
                        MyNewValue = myValue3![Patients Waiting]
 
 
                  End If
 
                If NoToRemove > 0 Then
 
                    If NoToRemove > MyNewValue Then
 
                        NoToRemove = NoToRemove - MyNewValue
 
                        MyNewValue = 0
 
                    ElseIf NoToRemove < MyNewValue Then
 
                        MyNewValue = MyNewValue - NoToRemove
 
                        NoToRemove = 0
 
                    End If
 
                End If
 
                DoEvents
 
                S = "INSERT INTO tbl1stAttempt ([Weeks Waited], [Patients Waiting], WeeksSinceApr06, Spec_ID)" _
                    & " VALUES (" & X & ", " & MyNewValue & ", " & WeekY & ", " & SID & ")"
 
                DoCmd.SetWarnings False
                    DoCmd.RunSQL S
                DoCmd.SetWarnings True
 
                RetVal = SysCmd(acSysCmdUpdateMeter, ProgAmount)
 
                ProgAmount = ProgAmount + 1
 
            Next X
 
            DoEvents
 
 
        Next WeekY
 
        DoEvents
 
    Next SID
 
    DoEvents
 
    RetVal = SysCmd(acSysCmdRemoveMeter)
 
    DoCmd.SetWarnings False
        DoCmd.OpenQuery "qryOutPut"
    DoCmd.SetWarnings True
 
    MsgBox ("Simulation Complete...!")
 
    DoCmd.Close acForm, "frmMain"
 
    Set rst = Nothing

I was thinking (well, hoping) that I would just replace the old variables (X, WeekY etc) with varArray(0,intArrayCount) etc, but alas, I was wrong.

Also, how do you update information in an array?

I've scoured the t'interweb but can't find anything that even touches what I need this to do.

I can't believe this is so hard for me to grasp. I may just pluck my eyes out an go live in a tree.