Wrox Programmer Forums

Need to download code?

View our list of code downloads.

Go Back   Wrox Programmer Forums > Microsoft Office > Access and Access VBA > Access VBA
Password Reminder
Register
Register | FAQ | Members List | Calendar | Search | Today's Posts | Mark Forums Read
Access VBA Discuss using VBA for Access programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Access VBA section of the Wrox Programmer to Programmer discussions. This is a community of tens of thousands of software programmers and website developers including Wrox book authors and readers. As a guest, you can read any forum posting. By joining today you can post your own programming questions, respond to other developersí questions, and eliminate the ads that are displayed to guests. Registration is fast, simple and absolutely free .
DRM-free e-books 300x50
Reply
 
Thread Tools Display Modes
  #1 (permalink)  
Old December 30th, 2013, 09:45 PM
Registered User
Points: 5, Level: 1
Points: 5, Level: 1 Points: 5, Level: 1 Points: 5, Level: 1
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: Dec 2013
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts
Default Forecasting Module

Hello Board!

I'm trying to create a forecasting module based on prior 12 months of sales data. Probably using linear regression and other stats based on the code I posted below. This code is set up for only 1 independent variable monthly sales and I want to use 12 months and have months as my dependent variable. Does anybody have any suggestions how this code can be modified? If not does anybody have any code I can use.

Enumeration used for determining which regression stat(s) the DSimpleRegress function returns

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

Last edited by tennisbuck; December 30th, 2013 at 09:51 PM.
Reply With Quote
Reply


Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is Off
HTML code is Off
Trackbacks are Off
Pingbacks are On
Refbacks are Off

Similar Threads
Thread Thread Starter Forum Replies Last Post
module umeshtheone Beginning VB 6 2 May 17th, 2007 06:48 AM
module umeshtheone VB Databases Basics 1 May 14th, 2007 02:41 PM
new module FT BOOK: ASP.NET 2.0 Website Programming Problem Design Solution ISBN: 978-0-7645-8464-0 2 March 15th, 2007 07:06 AM
module? flora8 Access VBA 2 September 7th, 2006 12:10 PM
Module sohrabus ASP.NET 2.0 Professional 1 September 1st, 2006 01:26 AM



All times are GMT -4. The time now is 11:13 AM.


Powered by vBulletin®
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
© 2013 John Wiley & Sons, Inc.