SQL & Array - Is this possible?? (1 Viewer)

[MrBen101]

Afternoon All!

Quick question, but it's got me stumped so I'm hoping there's a Genius out there who can help me out.

What I have is a table "tbl1stAttempt" with my initial data.

I've put this into an array "varArray"

I have an SQL statement

sqlNewValue3 = "SELECT [Patients Waiting] " _
& "FROM tbl1stAttempt " _
& "WHERE [Weeks Waited] = " & X - 1 & " AND [WeeksSinceApr06] = " & WeekY - 1 _
& " AND [Spec_ID] = " & SID

That looks at the table then brings back the corresponding record.
Only problem is that the rest of my code no longer updates the table, it goes straight to the array. What would I do to the code above to enable me to bring back values stored in varArray?

[Weeks Waited] is varArray(0,X)
[Patients Waiting] is varArray(1,X)
[WeeksSinceApr06] is varArray(2,X)
[Spec_ID] is varArray(3,X)

I'll give you a little background - apologies for the length of this - I posted elsewhere but not got a response yet an I'm desperate!

Ok, here we go:

This is for a waiting list simulator over a 52 week period for 19 different surgical specialtys project X amount of weeks into the future. Currently we are trying to project over 12 weeks.

The process is (so far anyway)

I get my list of patients by the weeks they have been waiting, specialty and weeks since april 06 (starts at 52)
I cannot change this data as it comes from other DBs which I'm not allowed to ask about let alone touch.

This goes into tbl1stAttempt (after it has been cleaned a little) in this format:

Weeks Waited Patients Waiting WeeksSinceApr06 Spec_ID
52 11 52 1
51 19 52 1
50 69 52 1
..... .... .... ....

etc etc so we have 1007 rows of data ( 53 week breakdown (0 to 52) by 19 Specialty codes)

I then have another table "tbl_Patients_To_Remove" that has the following fields:
Patients_To_Add
Patients_To_Remove
Specialty_Code
WeeksSinceApril06

The code I have so far looks up the patients to remove from tbl_Patients_To_Remove and removes them from the waiting list, starting with people who have been waiting the longest (week 52). Obviously we cannot have a negative number of people waiting so if the number to remove is greater than the amount of people waiting it will keep going through the list (for that specialty) until it produces a positive number. As we are now simulating a week in the future everything shift up one week (so week waited 51 becomes 52 etc) and week 53 is deleted (after being added to any value in week 52) and the figure in Patients_To_Add is put in week 0.

Wow, that was a bit of a waffle, sorry! Oh dear, here comes another load...

I've got the whole thing working using recordsets and SQL calls to update the table as it loops through the 1007 records another 11 times. The only problem I have is that it takes 15 minutes to update the table as it calls the SQL statement at the end 11077 times! This is why I need to switch it to an array.

I'm nearly there, it's just getting the sql to be able to reference a field in an array that I'm stuck with

I'll post the code I have so far (it's a bit messy as I'm changing thing continuously trying to get it to work)

Brace yourself!

Private Sub Command3_Click()
 
 
 
Dim DB As Database
Dim rst As Recordset
Dim X As Integer
Dim Y As Integer
Dim 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()
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 = 3
intArrayCount2 = rst.RecordCount
 
varArray = rst.GetRows()
 
rst.MoveFirst
 
X = varArray(0, intArrayCount)
MyNewValue = varArray(1, intArrayCount)
WeekY = varArray(2, intArrayCount)
SID = varArray(3, intArrayCount)
 
For SID = 1 To 19 Step 1
 
For WeekY = 53 To 64 Step 1
 
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
 
varArray(0, intArrayCount) = X
varArray(1, intArrayCount) = MyNewValue
varArray(2, intArrayCount) = WeekY
varArray(3, intArrayCount) = SID
 
'ReDim Preserve varArray(3, intArrayCount)
 
'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
 
intArrayCount = intArrayCount + 1
 
ReDim Preserve varArray(5, intArrayCount)
 
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
 
End Sub

I need to change all the references in tbl1stAttempt (inside the For ... Next loops) to look at varArray instead.

Thanks for looking!!

 

[Pat Hartman]

Rather than running multiple select and update queries couldn't you just open a single recordset (join the add and remove tables) and loop through it one time? If you can't join the two then open two recordsets and do a two-file match. Recordsets ARE arrays so it would be unusual to have to actually load records into an array. You would only do that if you had a small set of records that you needed to process multiple times and you couldn't use a join to accomplish the lookup for you. If I am following your logic at all, you are rerunning the queries to select a different set of records each time. You should be able to run them just once (don't forget an order by clause to ensure that the records are in a useable order).

 

[MrBen101]

Hi Pat.

Thanks for replying.

Unfortunately I'm not able to join the tables as the patients to add and the patients to remove are both added/removed to the same field in my main table, but one at Week 52 and 0.

I did it that way as it was the only way I knew how to get the desired results. It takes so long to loop through though I can't really expect the end user to sit and wait for 15 minutes for it to complete.

Am I correct in thinking that an array would be a lot quicker?

 

[dreamdelerium]

hey, any luck yet? im been looking at this post for awhile and its just hurting my head lol. could you list all the things you want to happen in order. ie:
step 1
step 2
step 3
if step 3 = what ever then step 4 else step 5
if not: it sounds like you want to take all the data from your array and put it into the proper tables. so, if its all in one array, first split the large array to smaller arrays (split according to whatever criteria). now, take each array, (delete the corresponding table records) and insert into the table. with such a large table, though, this will take time. instead, maybe, take each array, and each table see where the differnces are and only change those. am i close? if so, let me know and we can work from there

 

[MrBen101]

Hi there.

I'm close, just struggling turning this:

'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)

into this:

                For X = 52 To 0 Step -1
                
                    While X = 52
                    
                            While varArray(2, intArrayCount) = WeekY - 1
                                While varArray(3, intArrayCount) = SID
                                    NewValue2 = varArray(1, intArrayCount)
                                Wend
                            Wend
                
                    Wend
                
                    While X = 51
                    
                            While varArray(2, intArrayCount) = WeekY - 1
                                While varArray(3, intArrayCount) = SID
                                    NewValue = varArray(1, intArrayCount)
                                Wend
                            Wend
                    Wend
                    
                    
                    
                    If X = 52 Then
                    
                        MyNewValue = NewValue + NewValue2
                        
                    ElseIf X = 0 Then
    
                        MyNewValue = NoToAdd
    
                    Else:
    
                        While varArray(2, intArrayCount) = WeekY - 1
                            
                            MyNewValue = varArray(0, intArrayCount)
                           
                        Wend
                    
                    End If

Strange thing is it worked when I left work yesterday, and I came in this morning and it just throws itsself into an endless loop.

I'll keep hacking away with this method (it got me this far after all!) an see what happens. I've been working on this for about 3 weeks now and I've changed my approach so many times I'm loathed to do it again.

As soon as I get it sorted I'll post what I came up with!

Cheers,

Ben

 

[MrBen101]

I'VE DONE IT!!

For completeness here's what I came up with.

Any improvements please let me know!

Private Sub Command3_Click()
 
Dim DB As Database
Dim rst As Recordset
Dim X As Integer
Dim SID As Integer
Dim WeekY As Integer
Dim NoToRemove As Integer
Dim NoToAdd As Integer
Dim NewValue
Dim NewValue2
Dim MyNewValue
Dim ProgAmount As Integer
Dim RetVal As Variant
Dim rss As DAO.Recordset
 
    ProgAmount = 1
    RetVal = SysCmd(acSysCmdInitMeter, "Simulating Waiting List.....", 11077)
 
    Set DB = CurrentDb
    Set rst = DB.OpenRecordset("tbl1stAttempt", dbOpenDynaset)
    Set rss = DB.OpenRecordset("tbl_Patients_To_Remove", dbReadOnly)
 
    SID = rst![Spec_ID]
    X = rst![Weeks Waited]
    WeekY = rst![WeeksSinceApr06]
 
    For SID = 1 To 19 Step 1
 
        For WeekY = 53 To 64 Step 1
 
            NoToRemove = DLookup("[Patients_To_Remove]", "tbl_Patients_To_Remove", "[WeeksSinceApril06] = " & WeekY & " and [Specialty_Code] = " & SID)
 
            NoToAdd = DLookup("[Patients_To_Add]", "tbl_Patients_To_Remove", "[WeeksSinceApril06] = " & WeekY & " and [Specialty_Code] = " & SID)
 
                For X = 52 To 0 Step -1
 
                    If X = 52 Then
 
                        NewValue = DLookup("[Patients Waiting]", "tbl1stattempt", "[Weeks Waited] = 52 And [WeeksSinceApr06] = " & WeekY - 1 & " And [Spec_ID] = " & SID)
 
                        NewValue2 = DLookup("[Patients Waiting]", "tbl1stAttempt", "[Weeks Waited] = 51 And [WeeksSinceApr06] = " & WeekY - 1 & " And [Spec_ID] = " & SID)
 
                        MyNewValue = NewValue + NewValue2
 
                    ElseIf X = 0 Then
 
                        MyNewValue = NoToAdd
 
                    Else:
 
                        MyNewValue = DLookup("[Patients Waiting]", "tbl1stAttempt", "[Weeks Waited] = " & X - 1 & " And [WeeksSinceApr06] = " & WeekY - 1 & " And [Spec_ID] = " & SID)
 
                    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
 
                rst.AddNew
 
                rst![Weeks Waited] = X
                rst![Patients Waiting] = MyNewValue
                rst![WeeksSinceApr06] = WeekY
                rst![Spec_ID] = SID
 
                rst.Update
 
                RetVal = SysCmd(acSysCmdUpdateMeter, ProgAmount)
 
                ProgAmount = ProgAmount + 1
 
            Next X
 
            DoEvents
 
        Next WeekY
 
        DoEvents
 
    Next SID
 
    DoEvents
 
    RetVal = SysCmd(acSysCmdRemoveMeter)
 
    MsgBox ("Simulation Complete...!")
 
    DoCmd.Close acForm, "frmMain"
 
    Set rst = Nothing
    Set rss = Nothing
End Sub