VBA module for Access painfully slow - ms-access

Question

Doing data analysis for a lab and I have a table of samples that failed and all the criteria they could've failed on. Trying to add a field with a string listing which criteria each sample failed on.
I just learned VBA 2 weeks ago so I don't really know what I'm doing. I used recordset to turn my table into an array, then looped through each record to see if each criteria has failed and add it to a new failure array if it has. Then I print the failure array in an ugly concatenated string. There are less than 100 records but it's still very slow and sometimes crashes Access. Here's my code:
Option Compare Database
Option Explicit
Dim arrFails() As Variant
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim HType As Integer
Dim S As Integer
Public Sub MakeArrs()
On Error GoTo ErrorHandler
Set db = CurrentDb
'Set rs = db.OpenRecordset("S" & HType & "RptSimple")
Set rs = db.OpenRecordset("S31RptSimple")
rs.MoveLast
rs.MoveFirst
S = rs.RecordCount - 1
Debug.Print S
Dim arrRpt() As Variant
arrRpt = rs.GetRows(S + 1)
Debug.Print arrRpt(0, 0)
'This line creates an array arrFails with sample runs as rows, and 9 columns. Each column is a failure criteria.
ReDim arrFails(0 To S, 0 To 8) As Variant
Dim i As Long
Let i = 0
Dim index As Long
'This For loop starts at the first record in arrRpt and goes across the row with an If loop for each of the failure criteria.
'If the sample failed for that criteria, it populates the new arrFails array with the name of the criteria.
'If the sample passed, that spot on the array stays null.
'At the end of one loop, we have a row that ONLY has values for the criteria that failed.
For index = 0 To S
If arrRpt(2, i) < 0.85 Or IsNull(arrRpt(2, i)) = True Then
arrFails(i, 0) = "Correlation, "
End If
If arrRpt(3, i) > -0.4 Or arrRpt(3, i) < -2 Or IsNull(arrRpt(3, i)) = True Then
arrFails(i, 1) = "Slope, "
End If
If arrRpt(4, i) < 0.5 Or arrRpt(4, i) > 100 Or IsNull(arrRpt(4, i)) = True Then
arrFails(i, 2) = "Slope_Ratio, "
End If
If arrRpt(5, i) < 2 Or IsNull(arrRpt(5, i)) = True Then
arrFails(i, 3) = "Valid_Points, "
End If
If IsNull(arrRpt(6, i)) = False Then
arrFails(i, 4) = "Fail_Code, "
End If
If arrRpt(7, i) < 1.5 Or arrRpt(7, i) > 10 Or IsNull(arrRpt(7, i)) = True Then
arrFails(i, 5) = "DilutionRatio1, "
End If
If arrRpt(8, i) < 1.5 Or arrRpt(8, i) > 10 Or IsNull(arrRpt(8, i)) = True Then
arrFails(i, 6) = "DilutionRatio2, "
End If
arrFails(i, 8) = arrRpt(0, i)
i = i + 1
Next
rs.Close
'This is error handling code, so if something goes wrong it'll gracefully exit the code instead of getting some poor user stuck in debug hell.
ExitSub:
Exit Sub
ErrorHandler:
MsgBox "There's been an error."
Resume ExitSub
Set rs = Nothing
Set db = Nothing
End Sub
Public Function FailList2(HPVType, UIDFieldname)
HType = HPVType
Call MakeArrs
Dim x As Variant
x = 0
Do While x < S + 1
If UIDFieldname = arrFails(x, 8) Then
FailList2 = arrFails(x, 1) & arrFails(x, 0) & arrFails(x, 2) & arrFails(x, 3) & arrFails(x, 4) & arrFails(x, 5) & arrFails(x, 6)
Exit Do
End If
x = x + 1
Loop
End Function
Help a newbie out? There must be a more efficient way to do this. I tried turning echo off until the end of the FailList2 function but it didn't help. Note that I need to keep 'Htype' in the function. I'm just running this on one table right now, but when I fix it I have 8 more tables to run it on, hence the rs code I commented out at the beginning.

Answer 1

I have that function as a field in a query
Uh-oh. There is the problem. Just open the Immediate window, open your query and watch the Debug.Print statements roll in. The function will be executed over and over again.
You need to execute the function once, write the results not into an array (arrFails), but into a table instead. Use Recordset.AddNew to add records.
Then use that table as input for your query.