Code:
Option Compare Database
Enum SimpleRegressStat
SimpleRegressStat_All = 0
SimpleRegressStat_RSquared = 1
SimpleRegressStat_XCoeff = 2
SimpleRegressStat_Intercept = 3
SimpleRegressStat_SE_Resid = 4
SimpleRegressStat_SE_XCoeff = 5
SimpleRegressStat_SE_Intercept = 6
SimpleRegressStat_T_XCoeff = 7
SimpleRegressStat_T_Intercept = 8
End Enum
Function DSimpleRegress(X_Column As String, Y_Column As String, Tbl As String, _
Optional Criteria As String = "", Optional Stat As Variant = "")
' Function by Patrick G. Matthews
' Feel free to use and distribute this code, so long as you credit authorship and indicate the
' URL where you found it
' This function calculates statistics for simple linear regression between a single independent
' variable (X_Column) and a dependent variable (Y_Column), and is intended for use in Microsoft
' Access. This function requires a reference to the Microsoft DAO library.
' Depending on the value of the Stat argument, this function returns a single regression
' statistic, such as the R squared or the X coefficient, or it returns an array of all
' available regression stats (for a list of available stats, please see the enumeration
' SimpleRegressStat)
' If either or both corresponding values in the paired X, Y data set are null, those records
' are ignored
' This function is labeled according to the domain aggregate function naming convention as it
' behaves similarly to the other domain aggregates
' X_Column is the independent variable
' Y_Column is the dependent variable
' Tbl is the source table or query for the data
' Criteria defines any filtering criteria you wish to apply to the data set. Be sure to enclose
' text items in single quotes and date values in the # date qualifiers
' Stat determines which regression statistic the function returns. For a full list of the valid
' values (NOT case sensitive) for the Stat argument, see the Select Case structure under
' the label DetermineMode
' For each of the arguments, I strongly recommend that you encase column and table names in
' square brackets. This is mandatory of the column/table name does not follow the usual rules
' for naming database objects
Static Last_X_Column As String
Static Last_Y_Column As String
Static Last_Tbl As String
Static Last_Criteria As String
Static Last_Runtime As Date
Static Result_RSquared As Variant
Static Result_XCoeff As Variant
Static Result_Intercept As Variant
Static Result_SE_Resid As Variant
Static Result_SE_XCoeff As Variant
Static Result_SE_Intercept As Variant
Static Result_T_XCoeff As Variant
Static Result_T_Intercept As Variant
Dim N As Long
Dim AvgX As Variant
Dim AvgY As Variant
Dim AvgXY As Variant
Dim VarPX As Variant
Dim VarPY As Variant
Dim Covar As Variant
Dim SQL As String
Dim rs As DAO.Recordset
Dim Mode As SimpleRegressStat
Dim Results(1 To 8) As Variant
Const ForceRefreshSeconds As Long = 30
On Error GoTo ErrHandler
DetermineMode:
' Determines whether a single regression stat is returned (and if so, which), or whether
' an array of all available stats is returned
Select Case LCase(Stat)
Case "1", "r squared", "rsquared", "r sq", "rsq", "r square", "rsquare", "r-squared", "r-squared", _
"r-sq", "r-sq", "r-square", "r-square"
Mode = SimpleRegressStat_RSquared
Case "2", "x", "x coefficient", "x coeff", "xcoeff", "coeff", "coefficient"
Mode = SimpleRegressStat_XCoeff
Case "3", "intercept", "constant"
Mode = SimpleRegressStat_Intercept
Case "4", "se model", "se regression", "se resid", "se residual", "se residuals", "std error model", _
"std error regression", "std error resid", "std error residual", "std error residuals", _
"standard error model", "standard error regression", "standard error resid", _
"standard error residual", "standard error residuals"
Mode = SimpleRegressStat_SE_Resid
Case "5", "se x", "se x coefficient", "se x coeff", "se xcoeff", "se coeff", "se coefficient", _
"std error x", "std error x coefficient", "std error x coeff", "std error xcoeff", _
"std error coeff", "std error coefficient", "standard error x", "standard error x coefficient", _
"standard error x coeff", "standard error xcoeff", "standard error coeff", _
"standard error coefficient"
Mode = SimpleRegressStat_SE_XCoeff
Case "6", "se intercept", "se constant", "std error intercept", "std error constant", _
"standard error intercept", "standard error constant"
Mode = SimpleRegressStat_SE_Intercept
Case "7", "t x", "t x coefficient", "t x coeff", "t xcoeff", "t coeff", "t coefficient"
Mode = SimpleRegressStat_T_XCoeff
Case "8", "t intercept", "t constant"
Mode = SimpleRegressStat_T_Intercept
Case Else
Mode = SimpleRegressStat_All
End Select
CalculateStats:
' Calculate the regression stats
' This function holds the regression stats in static variables, which retain their state
' between calls. If the values for the X_Column, Y_Column, Tbl, and Criteria arguments
' are the same as those for the last call, and if the seconds elapsed since the last
' call are less than what is specified in the ForceRefreshSeconds constant, then we can
' skip the calculations and go right to assigning the return value
If DateDiff("s", Last_Runtime, Now) >= ForceRefreshSeconds Or Last_X_Column <> X_Column Or _
Last_Y_Column <> Y_Column Or Last_Tbl <> Tbl Or Last_Criteria <> Criteria Then
' Initialize stats to null
Result_RSquared = Null
Result_XCoeff = Null
Result_Intercept = Null
Result_SE_Resid = Null
Result_SE_XCoeff = Null
Result_SE_Intercept = Null
Result_T_XCoeff = Null
Result_T_Intercept = Null
' All the regression stats can be calculated from the following six values: N, Avg(X), Avg(Y),
' Avg(X * Y), VarP(X), and VarP(Y). Use the following SQL statement to get these six values
SQL = "SELECT Count(1) AS N, Avg(" & X_Column & ") AS AvgX, Avg(" & Y_Column & ") AS AvgY, " & _
"Avg(" & X_Column & " * " & Y_Column & ") AS AvgXY, VarP(" & X_Column & ") AS VarPX, " & _
"VarP(" & Y_Column & ") AS VarPY " & _
"FROM " & Tbl & " " & _
"WHERE " & IIf(Trim(Criteria) <> "", Criteria & " And ", "") & X_Column & " Is Not Null " & _
"And " & Y_Column & " Is Not Null"
Set rs = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)
' Transfer values from recordset to variables, then close recordset
AvgX = CDbl(rs!AvgX)
AvgY = CDbl(rs!AvgY)
AvgXY = CDbl(rs!AvgXY)
N = rs!N
VarPX = CDbl(rs!VarPX)
VarPY = CDbl(rs!VarPY)
Covar = AvgXY - AvgX * AvgY
rs.Close
' There must be at least 3 valid data points for regression to work. If there are 2 or
' fewer data points, we skip the rest of the calculations, thus allowing the regression
' stats to remain as null
If N > 2 Then
' Calculate various stats
Result_RSquared = Covar ^ 2 / (VarPX * VarPY)
Result_XCoeff = Covar / VarPX
Result_Intercept = AvgY - AvgX * Result_XCoeff
Result_SE_Resid = ((N / (N - 2)) * (VarPY - Covar ^ 2 / VarPX)) ^ 0.5
Result_SE_XCoeff = Result_SE_Resid * (1 / (N * VarPX)) ^ 0.5
Result_SE_Intercept = Result_SE_Resid * ((VarPX + AvgX ^ 2) / (N * VarPX)) ^ 0.5
Result_T_XCoeff = Result_XCoeff / Result_SE_XCoeff
Result_T_Intercept = Result_Intercept / Result_SE_Intercept
End If
End If
ReturnValue:
' Set the fnction's return value
Select Case Mode
Case SimpleRegressStat_All
Results(1) = Result_RSquared
Results(2) = Result_XCoeff
Results(3) = Result_Intercept
Results(4) = Result_SE_Resid
Results(5) = Result_SE_XCoeff
Results(6) = Result_SE_Intercept
Results(7) = Result_T_XCoeff
Results(8) = Result_T_Intercept
DSimpleRegress = Results
Case SimpleRegressStat_RSquared
DSimpleRegress = Result_RSquared
Case SimpleRegressStat_XCoeff
DSimpleRegress = Result_XCoeff
Case SimpleRegressStat_Intercept
DSimpleRegress = Result_Intercept
Case SimpleRegressStat_SE_Resid
DSimpleRegress = Result_SE_Resid
Case SimpleRegressStat_SE_XCoeff
DSimpleRegress = Result_SE_XCoeff
Case SimpleRegressStat_SE_Intercept
DSimpleRegress = Result_SE_Intercept
Case SimpleRegressStat_T_XCoeff
DSimpleRegress = Result_T_XCoeff
Case SimpleRegressStat_T_Intercept
DSimpleRegress = Result_T_Intercept
End Select
Last_Runtime = Now
GoTo Cleanup
ErrHandler:
DSimpleRegress = CVErr(Err.Number)
Cleanup:
Set rs = Nothing
End Function
Windows Vista 
Access 2007
Reply With Quote
