# Multiple linear regression in VBA

#### acunnold

##### New Member
I am writing a macro for multiple linear regression in VBA. However it doesn't work.

Anyone who can tell my why please let me know.
THANKS!

Code:
``````Function RegressArray(y As Variant, X As Variant) As Variant

Dim Xtrans() As Variant
Dim btemp() As Variant
Dim b() As Variant

Xtrans = Application.Transpose(X)
btemp = Application.MMult(Application.MInverse(Application.MMult(Xtrans, X)), Xtrans)
RegressArray = Application.MMult(btemp, y)

End Function

Function Regressconst(y As Range, X As Range) As Double

Dim outputarray As Variant

outputarray = RegressArray(y, X)
Regressconst = outputarray(1)

End Function

Function RegressVar1(y As Range, X As Range) As Double

Dim outputarray As Variant

outputarray = RegressArray(y, X)
RegressVar1 = outputarray(2)

End Function``````

### Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

#### sweater_vests_rock

##### Well-known Member
acu.

i don't think i need to say that you're being a little vague here. what do you mean by "does not work?"

since you're doing regression, i'm assuming X and Y are really ranges. i would declare them as such. doing so, i was able to return a matrix from regressionarray(), so long as i picked the correct dimensions for the array.

may i ask why you are doing this? excel does have the ability to run multiple regression in the data analysis tool-pak.

thanks. ben.

ps. for my solution to multiple linear regression in excel, see below. this includes a test for heteroskedasticity, and it mimics the output format of the excel data analysis pak. my "inspiration" was getting around excel's limit of 16 dependent variables. unfortunately, i'm not very good at vba now, and i was even less experienced then.

Code:
``````Option Explicit
Option Base 1

Sub Regression()
'Written by Ben Marston January 2005

'General Formulae
'Y = X * B + e
'B = INV(XT * X) * XT * Y
'sigma^2 = (YT*Y - BT*XT*Y)
'So if e^2 = a0 + a1yhat + a2(yhat)^2, then [e^2] = [1 yhat yhat^2]*[a] + u
'[1 to row_count_ir, 1] = [1 to row_count_ir, 3] * [1 to 3, 1] + [1 to row_count_ir, 1]

Dim input_continue As Integer, error_sub_checker As Integer
Dim range_sheet As String
Dim independent_range As Range, dependent_range, name_range_ir, name_range_dr As Range
Dim row_count_ir As Long, row_count_dr As Long
Dim column_count_ir As Integer, column_count_dr As Integer
Dim array_matrixX() As Double, array_matrixXT() As Double, array_matrixXTX() As Double, _
array_matrixinvXTX() As Double, array_matrixXTY() As Double, array_matrixXTE2() As Double
Dim array_matrixY() As Double, array_matrixE2() As Double, array_matrixYT() As Double, _
array_matrixB() As Double, array_matrixB_WHITE() As Double, array_matrixBT() As Double, _
array_matrixBT_WHITE() As Double, array_matrixXB() As Double, array_matrixXB_WHITE() As Double, _
array_matrixY2() As Double, array_matrixVCM() As Double
Dim array_matrixRegressionTable() As Double
Dim average_y As Double, average_E2 As Double, SIGMA2 As Double, SSE As Double, SSR As Double, _
SST As Double, SIGMA2_WHITE As Double, SSE_WHITE As Double, SSR_WHITE As Double, SST_WHITE _
As Double, DF As Double, R2 As Double, R2_WHITE As Double, ADJ_R2 As Double, SE As Double, _
F As Double, F_sig As Double, F_WHITE As Double, F_WHITE_sig As Double, D_W As Double, _
D_W_sig As Double, F_RAMSEY As Double, F_RAMSEY_sig As Double
Dim array_Names() As String, names_dr As String
'**Global Variable Declarations**

input_continue = 0
'Ensures data is entered in column format
error_sub_checker = 0
'Breaks on input error
range_sheet = vbNullString
'Sheet containing the regression data
names_dr = vbNullString
'Stores the variable name of the dependent variable
column_count_ir = 0
'Number of columns in the independent range (1 to 256)
column_count_dr = 0
'Number of columns in the dependent range (should be =1)
row_count_ir = 0
'Number of rows in the independent range (should be equivalent to row_count_dr)
row_count_dr = 0
'Number of rows in the dependent range (should be equivalent to row_count_ir)
average_y = 0
'Mean observed Y-value
average_E2 = 0
'Mean observed squared error from regression
SIGMA2 = 0
'Variance of the regression estimate
SIGMA2_WHITE = 0
'Variance of the White regression estimate
SSE = 0
SSR = 0
SST = 0
SSE_WHITE = 0
SSR_WHITE = 0
SST_WHITE = 0
DF = 0
'Degrees of Freedom of the model
R2 = 0
'R^2 correlation measures the amount of observed variation attributable to the regression estimate
R2_WHITE = 0
'R^2 correlation measures amount of observed error-squared variation attributable the White regression estimate
'R^2 correlation measure adjusted for the number of regressors
SE = 0
'Standard error of the regression equation
F = 0
'F-statistics for overall model appropriateness
F_sig = 0
'Returned from FDist of F, representing the p-value of the F-statistic
F_WHITE = 0
'F-statistic generated from White's Test
F_WHITE_sig = 0
'Returned from FDist of F_WHITE, representing the p-value of the White F-Statistic
D_W = 0
'Durbin-Watson value to measure multicollinearity
D_W_sig = 0
F_RAMSEY = 0
'F-statistic generated from Ramsey's RESET test of model specification appropriateness
F_RAMSEY_sig = 0
'Returned from FDist of F_RAMSEY, representing the p-value of the Ramsey F-statistic

input_continue = MsgBox("Variables must be ordered by columns.  Click 'OK' to continue or 'Cancel' to quit.", vbExclamation + vbOKCancel)

If input_continue <> 2 Then

Call Range_Components(independent_range, dependent_range, name_range_ir, name_range_dr, _
row_count_ir, column_count_ir, column_count_dr, average_y, range_sheet, _
error_sub_checker, array_Names(), names_dr)

If error_sub_checker <> 1 Then

'This routine generates the matrices necessary to run multiple linear regression
Call Array_Components(independent_range, dependent_range, row_count_ir, _
column_count_ir, column_count_dr, average_y, average_E2, SSE, SST, SSR, SIGMA2, _
SSE_WHITE, SST_WHITE, SSR_WHITE, SIGMA2_WHITE, DF, array_matrixX(), array_matrixXT(), _
array_matrixXTX(), array_matrixinvXTX(), array_matrixXTY(), array_matrixXTE2(), _
array_matrixY(), array_matrixYT(), array_matrixB(), array_matrixB_WHITE(), _
array_matrixBT(), array_matrixBT_WHITE, array_matrixXB(), array_matrixXB_WHITE, _
array_matrixY2(), array_matrixE2(), array_matrixVCM(), array_matrixRegressionTable())

'This routine prints outputs (useful for checking errors)
'Call Array_Output(row_count_ir, column_count_ir, column_count_dr, array_matrixX(), array_matrixXT(), array_matrixinvXTX(), array_matrixXTX(), array_matrixXTY(), array_matrixB(), array_matrixBT(), array_matrixXB(), array_matrixVCM(), array_matrixRegressionTable())

'This routine calculates the various test statistics
Call Statistic_Components(row_count_ir, column_count_ir, SIGMA2, SIGMA2_WHITE, SSE, SST, _
SSE_WHITE, SST_WHITE, DF, R2, R2_WHITE, ADJ_R2, SE, F, F_sig, F_WHITE, F_WHITE_sig)

'This routine outputs the results
Call Statistic_Output(row_count_ir, column_count_ir, SSE, SSE_WHITE, SSR, SSR_WHITE, SST, _
SST_WHITE, DF, R2, R2_WHITE, ADJ_R2, SE, F, F_sig, F_WHITE, F_WHITE_sig, D_W, D_W_sig, _
F_RAMSEY, F_RAMSEY_sig, array_matrixY(), array_matrixXB(), _
array_matrixRegressionTable(), array_Names())

End If
End If

End Sub

Sub Range_Components(independent_range, dependent_range, name_range_ir, name_range_dr, _
row_count_ir, column_count_ir, column_count_dr, average_y, range_sheet, _
error_sub_checker, array_Names() As String, names_dr)

Dim row_count_dr As Long
Dim area_count_ir As Integer, area_count_dr As Integer, name_count_ir As Integer, name_count_dr As Integer
Dim error_row_count_checker As Integer, error_area_count_checker As Integer, error_names As Integer
Dim cell_names As Integer, create_names As Integer
Dim counter_names As Integer

area_count_ir = 0
area_count_dr = 0
name_count_ir = 0
name_count_dr = 0

cell_names = 0
create_names = 0

error_row_count_checker = 0
error_area_count_checker = 0
error_names = 0

counter_names = 1

Do
error_area_count_checker = 0

Set independent_range = Application.InputBox("Highlight the independent observations. This must be a contiguous range.", "Input Variables", Type:=8)
Set dependent_range = Application.InputBox("Highlight the dependent observations.  This should only be a single column.", "Input Variables", Type:=8)

range_sheet = ActiveSheet.Name

area_count_ir = independent_range.Areas.Count
area_count_dr = dependent_range.Areas.Count

If area_count_ir And area_count_dr <> 1 Then
error_area_count_checker = MsgBox("You cannot carry out this macro on multi-area selections.", vbExclamation + vbRetryCancel, "Error: Non-Contiguous Range")
End If
Loop While error_area_count_checker = 4

If error_area_count_checker = 0 Then
Do
error_row_count_checker = 0

row_count_ir = independent_range.Rows.Count
column_count_ir = independent_range.Columns.Count
row_count_dr = dependent_range.Rows.Count
column_count_dr = dependent_range.Columns.Count

If row_count_ir <> row_count_dr Then
error_row_count_checker = MsgBox("The number of independent and dependent observations must be equal.  Would you like to re-select the ranges?", vbRetryCancel)
End If
Loop While error_row_count_checker = 4

ReDim array_Names(1 To column_count_ir + 1)

cell_names = MsgBox("Are the variable names entered in cells?", vbYesNo)
If cell_names = 6 Then
Do
Set name_range_ir = Application.InputBox("Highlight the independent variable names", Type:=8)
Set name_range_dr = Application.InputBox("Highlight the dependent variable name.", Type:=8)

name_count_ir = name_range_ir.Columns.Count
name_count_dr = name_range_dr.Columns.Count

If name_count_ir <> column_count_ir Then
name_count_ir = name_range_ir.Rows.Count
If name_count_ir <> column_count_ir Then
error_names = MsgBox("The number of independent variable names is different from the number of independent variables.", vbRetryCancel)
Else
array_Names(counter_names) = "INTERCEPT"
Do
counter_names = counter_names + 1
array_Names(counter_names) = name_range_ir.Cells(counter_names - 1, 1)
Loop While counter_names < column_count_ir + 1
names_dr = name_range_dr.Cells(1, 1).Value
End If
Else
array_Names(counter_names) = "INTERCEPT"
Do
counter_names = counter_names + 1
array_Names(counter_names) = name_range_ir.Cells(1, counter_names - 1)
Loop While counter_names < column_count_ir + 1
End If
Loop While error_names = 4
End If

If cell_names = 7 Or error_names = 5 Then
create_names = MsgBox("Would you like to create variable names?  If 'No', default names will be used.", vbYesNo)
If create_names = 6 Then
array_Names(counter_names) = "INTERCEPT"
Do
counter_names = counter_names + 1
array_Names(counter_names) = InputBox("Enter the name for independent variable " & counter_names - 1)
Loop While counter_names < column_count_ir + 1
names_dr = InputBox("Enter the name for the dependent variable.")
Else
array_Names(counter_names) = "INTERCEPT"
Do
counter_names = counter_names + 1
array_Names(counter_names) = "X" & counter_names - 1
Loop While counter_names < column_count_ir + 1
names_dr = "Y"
End If
End If

average_y = Application.WorksheetFunction.Average(dependent_range)

'**STILL MIGHT NEED ERROR TRAP FOR TOO MANY ROWS???**

Else
error_sub_checker = 1
End If

End Sub

Sub Array_Components(independent_range, dependent_range, row_count_ir, column_count_ir, _
column_count_dr, average_y, average_E2, SSE, SST, SSR, SIGMA2, SSE_WHITE, SST_WHITE, _
SSR_WHITE, SIGMA2_WHITE, DF, array_matrixX() As Double, array_matrixXT() As Double, _
array_matrixXTX() As Double, array_matrixinvXTX() As Double, array_matrixXTY() As Double, _
array_matrixXTE2() As Double, array_matrixY() As Double, array_matrixYT() As Double, _
array_matrixB() As Double, array_matrixB_WHITE() As Double, array_matrixBT() As Double, _
array_matrixBT_WHITE() As Double, array_matrixXB() As Double, array_matrixXB_WHITE() As _
Double, array_matrixY2() As Double, array_matrixE2() As Double, array_matrixVCM() As Double, _
array_matrixRegressionTable() As Double)

Dim counter_dim, counter_dim2, counter_row As Long
Dim counter_dim1, counter_column As Integer
Dim counter_sum As Double

counter_dim = 0
counter_dim1 = 0
counter_dim2 = 0
counter_row = 0
counter_column = 1
column_count_ir = column_count_ir + 1
'***To account for Bnot

ReDim array_matrixX(1 To row_count_ir, 1 To column_count_ir)
ReDim array_matrixXT(1 To column_count_ir, 1 To row_count_ir)
ReDim array_matrixXTX(1 To column_count_ir, 1 To column_count_ir)
ReDim array_matrixinvXTX(1 To column_count_ir, 1 To column_count_ir)
ReDim array_matrixXTY(1 To column_count_ir, 1)
ReDim array_matrixXTE2(1 To column_count_ir, 1)
ReDim array_matrixY(1 To row_count_ir, 1)
ReDim array_matrixYT(1, 1 To row_count_ir)
ReDim array_matrixB(1 To column_count_ir, 1)
ReDim array_matrixB_WHITE(1 To column_count_ir, 1)
ReDim array_matrixBT(1, 1 To column_count_ir)
ReDim array_matrixBT_WHITE(1, 1 To column_count_ir)
ReDim array_matrixXB(1 To row_count_ir, 1)
ReDim array_matrixXB_WHITE(1 To row_count_ir, 1)
ReDim array_matrixY2(1 To row_count_ir, 1)
ReDim array_matrixE2(1 To row_count_ir, 1)
ReDim array_matrixVCM(1 To column_count_ir, 1 To column_count_ir)
ReDim array_matrixRegressionTable(1 To column_count_ir, 4)
'***Creates appropriately-sized arrays given user-defined selection

'************************************************************************************
' CREATING MATRICES X, XT, Y, YT
'************************************************************************************
Do
counter_row = counter_row + 1
counter_column = 1
array_matrixX(counter_row, counter_column) = 1
'***Inserts 1 into first column of array_matrixX
array_matrixXT(counter_column, counter_row) = 1
'***Transposes the first column of array_matrixX
array_matrixY(counter_row, counter_column) = dependent_range.Cells(counter_row, counter_column)
array_matrixYT(counter_column, counter_row) = dependent_range.Cells(counter_row, counter_column)
Do
counter_column = counter_column + 1
array_matrixX(counter_row, counter_column) = independent_range.Cells(counter_row, counter_column - 1)
'***Creates array_matrixX from user-selection
array_matrixXT(counter_column, counter_row) = independent_range.Cells(counter_row, counter_column - 1)
'***Transposes array_matrixX
Loop While counter_column < column_count_ir
Loop While counter_row < row_count_ir

'************************************************************************************
' CALCULATING MATRIX XTX = XT * X
'************************************************************************************
'***dim1 <= dim2
Do
counter_dim = counter_dim + 1
'***counter_dim scrolls through the rows of XT
counter_dim1 = 0
'***counter_dim1 scrolls through the columns of X
Do
counter_dim1 = counter_dim1 + 1

counter_dim2 = 0
'***counter_dim2 scolls through the rows of X
counter_sum = 0
'***counter_sum tracks the value of array_matrixXTX(counter_dim, counter_dim1)
Do
counter_dim2 = counter_dim2 + 1
counter_sum = counter_sum + array_matrixXT(counter_dim, counter_dim2) * array_matrixX(counter_dim2, counter_dim1)
Loop While counter_dim2 < row_count_ir

array_matrixXTX(counter_dim, counter_dim1) = counter_sum
'**counter_sum is stored in the appropriate row/column of the array

Loop While counter_dim1 < column_count_ir

Loop While counter_dim < column_count_ir

'************************************************************************************
' CALCULATING MATRIX INV(XTX) = INV(XT * X)
'************************************************************************************
counter_row = 0
counter_column = 0
Do
counter_row = counter_row + 1
counter_column = 0
Do
counter_column = counter_column + 1
array_matrixinvXTX(counter_row, counter_column) = Application.Index((Application.MInverse(array_matrixXTX)), counter_row, counter_column)
'***Inverts array_matrixXTX
Loop While counter_column < column_count_ir
Loop While counter_row < column_count_ir

'************************************************************************************
' CALCULATING MATRIX XTY = XT * Y
'************************************************************************************
counter_dim = 0
'***counter_dim scrolls through the rows of XT
'***dim1 <= dim2
Do
counter_dim = counter_dim + 1
counter_dim1 = 0
'***counter_dim1 scrolls through the columns of Y
Do
counter_dim1 = counter_dim1 + 1
counter_dim2 = 0
'***counter_dim2 scolls through the rows of Y
counter_sum = 0
'***counter_sum tracks the value of array_matrixXTY(counter_dim, counter_dim1)
Do
counter_dim2 = counter_dim2 + 1
counter_sum = counter_sum + array_matrixXT(counter_dim, counter_dim2) * array_matrixY(counter_dim2, counter_dim1)
Loop While counter_dim2 < row_count_ir

array_matrixXTY(counter_dim, counter_dim1) = counter_sum
'***counter_sum is stored in the appropriate row/column of the array

Loop While counter_dim1 < column_count_dr
Loop While counter_dim < column_count_ir

'************************************************************************************
' CALCULATING MATRIX B = INV(XTX)*(XTY), CREATING MATRIX BT
'************************************************************************************
counter_dim = 0
'***counter_dim scolls through the columns of INV(XTX)
Do
counter_dim = counter_dim + 1
counter_dim1 = 0
'***counter_dim1 scolls through the columns of XTY
Do
counter_dim1 = counter_dim1 + 1
counter_dim2 = 0
'***counter_dim2 scolls through the rows of XTY
counter_sum = 0
'***counter_sum tracks the value of array_matrixB(counter_dim, counter_dim1)
Do
counter_dim2 = counter_dim2 + 1
counter_sum = counter_sum + array_matrixinvXTX(counter_dim, counter_dim2) * array_matrixXTY(counter_dim2, counter_dim1)
Loop While counter_dim2 < column_count_ir

array_matrixB(counter_dim, counter_dim1) = counter_sum
array_matrixBT(counter_dim1, counter_dim) = counter_sum
'***counter_sum is stored in the appropriate row/column of the array
Loop While counter_dim1 < column_count_dr
Loop While counter_dim < column_count_ir

'************************************************************************************
' CALCULATING MATRIX XB(Y-HAT) = X*B, CREATING MATRIX Y2 (y-hat^2), CALCULATING MATRIX E2 (e^2 = (y - y-hat)^2, CALCULATING average_E2
'************************************************************************************
counter_dim = 0
'***counter_dim scolls through the rows of X
Do
counter_dim = counter_dim + 1
counter_dim1 = 0
'***counter_dim1 scolls through the columns of B
Do
counter_dim1 = counter_dim1 + 1
counter_dim2 = 0
'***counter_dim2 scolls through the rows of B
counter_sum = 0
'***counter_sum tracks the value of array_matrixXB(counter_dim, counter_dim1)
Do
counter_dim2 = counter_dim2 + 1
counter_sum = counter_sum + array_matrixX(counter_dim, counter_dim2) * array_matrixB(counter_dim2, counter_dim1)
Loop While counter_dim2 < column_count_ir

array_matrixXB(counter_dim, counter_dim1) = counter_sum
array_matrixY2(counter_dim, counter_dim1) = counter_sum ^ 2
array_matrixE2(counter_dim, counter_dim1) = (array_matrixY(counter_dim, counter_dim1) - array_matrixXB(counter_dim, counter_dim1)) ^ 2
average_E2 = average_E2 + array_matrixE2(counter_dim, counter_dim1)
'***counter_sum is stored in the appropriate row/column of the array
Loop While counter_dim1 < column_count_dr
Loop While counter_dim < row_count_ir

average_E2 = average_E2 / row_count_ir

'************************************************************************************
' CALCULATING MATRIX XTE2 = XT * E2
'************************************************************************************
counter_dim = 0
'***counter_dim scrolls through the rows of XT
'***dim1 <= dim2
Do
counter_dim = counter_dim + 1
counter_dim1 = 0
'***counter_dim1 scrolls through the columns of Y
Do
counter_dim1 = counter_dim1 + 1
counter_dim2 = 0
'***counter_dim2 scolls through the rows of Y
counter_sum = 0
'***counter_sum tracks the value of array_matrixXTY(counter_dim, counter_dim1)
Do
counter_dim2 = counter_dim2 + 1
counter_sum = counter_sum + array_matrixXT(counter_dim, counter_dim2) * array_matrixE2(counter_dim2, counter_dim1)
Loop While counter_dim2 < row_count_ir

array_matrixXTE2(counter_dim, counter_dim1) = counter_sum
'***counter_sum is stored in the appropriate row/column of the array

Loop While counter_dim1 < column_count_dr
Loop While counter_dim < column_count_ir

'************************************************************************************
' CALCULATING MATRIX B_WHITE = INV(XTX)*(XTE2), CREATING MATRIX BT_WHITE
'************************************************************************************
counter_dim = 0
'***counter_dim scolls through the columns of INV(XTX)
Do
counter_dim = counter_dim + 1
counter_dim1 = 0
'***counter_dim1 scolls through the columns of XTE2
Do
counter_dim1 = counter_dim1 + 1
counter_dim2 = 0
'***counter_dim2 scolls through the rows of XTE2
counter_sum = 0
'***counter_sum tracks the value of array_matrixB(counter_dim, counter_dim1)
Do
counter_dim2 = counter_dim2 + 1
counter_sum = counter_sum + array_matrixinvXTX(counter_dim, counter_dim2) * array_matrixXTE2(counter_dim2, counter_dim1)
Loop While counter_dim2 < column_count_ir

array_matrixB_WHITE(counter_dim, counter_dim1) = counter_sum
array_matrixBT_WHITE(counter_dim1, counter_dim) = counter_sum
'***counter_sum is stored in the appropriate row/column of the array
Loop While counter_dim1 < column_count_dr
Loop While counter_dim < column_count_ir

'************************************************************************************
' CALCULATING SSE = sum((X*B)i - mean(y)^2), SSE_WHITE = sum((X*B)i - mean(e^2)
'************************************************************************************
counter_row = 0
'***counter_row scolls through the rows of XB
Do
counter_row = counter_row + 1
counter_column = 0
'***counter_column scrolls through the columns of XB
Do
counter_column = counter_column + 1
SSE = SSE + (array_matrixXB(counter_row, counter_column) - average_y) ^ 2
SSE_WHITE = SSE_WHITE + (array_matrixXB_WHITE(counter_row, counter_column) - average_E2) ^ 2
Loop While counter_column < column_count_dr
Loop While counter_row < row_count_ir

'************************************************************************************
' CALCULATING SST = sum((Y)i - mean(y)^2), SSR = SST - SSE, SST_WHITE = sum((E2)i - mean(e2)^2, SSR_WHITE = SST_WHITE - SSE_WHITE
'************************************************************************************
counter_row = 0
'***counter_row scolls through the rows of Y
Do
counter_row = counter_row + 1
counter_column = 0
'***counter_column scrolls through the columns of Y
Do
counter_column = counter_column + 1
SST = SST + (array_matrixY(counter_row, counter_column) - average_y) ^ 2
SST_WHITE = SST_WHITE + (array_matrixE2(counter_row, counter_column) - average_E2) ^ 2
Loop While counter_column < column_count_dr
Loop While counter_row < row_count_ir

'************************************************************************************
' CALCULATING SIGMA2 = SSR / DF
'************************************************************************************

SSR = SST - SSE
SSR_WHITE = SST_WHITE - SSE_WHITE
DF = row_count_ir - column_count_ir
SIGMA2 = SSR / DF
SIGMA2_WHITE = SSR_WHITE / DF

'************************************************************************************
' CALCULATING VARIANCE-COVARIANCE MATRIX = SIGMA2*INV(XTX), CREATING array_matrixRegressionTable
'************************************************************************************
counter_dim = 0
counter_row = 0
'***counter_row scolls through the rows of INV(XTX)
Do
counter_row = counter_row + 1
counter_column = 0
'***counter_column scrolls through the columns of INV(XTX)
Do
counter_column = counter_column + 1
array_matrixVCM(counter_row, counter_column) = array_matrixinvXTX(counter_row, counter_column) * SIGMA2
If counter_column = counter_row Then
counter_dim = counter_dim + 1
array_matrixRegressionTable(counter_dim, 1) = array_matrixB(counter_dim, 1)
array_matrixRegressionTable(counter_dim, 2) = (array_matrixVCM(counter_row, counter_column)) ^ (1 / 2)
array_matrixRegressionTable(counter_dim, 3) = array_matrixRegressionTable(counter_dim, 1) / array_matrixRegressionTable(counter_dim, 2)
array_matrixRegressionTable(counter_dim, 4) = Application.WorksheetFunction.TDist(Abs(array_matrixRegressionTable(counter_dim, 3)), DF, 2)
End If
Loop While counter_column < column_count_ir
Loop While counter_row < column_count_ir

End Sub

Sub Statistic_Components(row_count_ir, column_count_ir, SIGMA2, SIGMA2_WHITE, SSE, SST, SSE_WHITE, SST_WHITE, _
DF, R2, R2_WHITE, ADJ_R2, SE, F, F_sig, F_WHITE, F_WHITE_sig)

R2 = SSE / SST
R2_WHITE = SSE_WHITE / SST_WHITE
ADJ_R2 = 1 - (1 - R2) * ((row_count_ir - 1) / DF)
F = (R2 / (column_count_ir - 1)) / ((1 - R2) / (row_count_ir - column_count_ir))
F_WHITE = (R2_WHITE / (column_count_ir - 1)) / ((1 - R2_WHITE) / (row_count_ir - column_count_ir))
F_sig = Application.WorksheetFunction.FDist(F, column_count_ir - 1, row_count_ir - column_count_ir)
F_WHITE_sig = Application.WorksheetFunction.FDist(F_WHITE, column_count_ir - 1, row_count_ir - column_count_ir)
SE = (SIGMA2) ^ (1 / 2)

End Sub

Sub Array_Output(row_count_ir, column_count_ir, column_count_dr, array_matrixX() As Double, _
array_matrixXT() As Double, array_matrixinvXTX() As Double, array_matrixXTX() As Double, _
array_matrixXTY() As Double, array_matrixB() As Double, array_matrixBT() As Double, _
array_matrixXB() As Double, array_matrixVCM() As Double, array_matrixRegressionTable() _
As Double)

Dim counter_column_output As Integer, counter_row_output As Integer

Application.ScreenUpdating = False

'*** OUTPUTS MATRIX X ****
counter_row_output = 0
counter_column_output = 0
Do
counter_row_output = counter_row_output + 1
counter_column_output = 0
Do
counter_column_output = counter_column_output + 1
Worksheets("Matrix - X").Cells(counter_row_output, counter_column_output) = array_matrixX(counter_row_output, counter_column_output)
Loop While counter_column_output < column_count_ir
Loop While counter_row_output < row_count_ir

'*** OUTPUTS MATRIX XT ****
counter_row_output = 0
counter_column_output = 0
Do
counter_row_output = counter_row_output + 1
counter_column_output = 0
Do
counter_column_output = counter_column_output + 1
Worksheets("Matrix - XT").Cells(counter_row_output, counter_column_output) = array_matrixXT(counter_row_output, counter_column_output)
Loop While counter_column_output < row_count_ir
Loop While counter_row_output < column_count_ir

'*** OUTPUTS MATRIX XTX ****
counter_row_output = 0
counter_column_output = 0
Do
counter_row_output = counter_row_output + 1
counter_column_output = 0
Do
counter_column_output = counter_column_output + 1
Worksheets("Matrix - XTX").Cells(counter_row_output, counter_column_output) = array_matrixXTX(counter_row_output, counter_column_output)
Loop While counter_column_output < column_count_ir
Loop While counter_row_output < column_count_ir

'*** OUTPUTS MATRIX INV(XTX) ****
counter_row_output = 0
counter_column_output = 0
Do
counter_row_output = counter_row_output + 1
counter_column_output = 0
Do
counter_column_output = counter_column_output + 1
Worksheets("Matrix - InvXTX").Cells(counter_row_output, counter_column_output) = array_matrixinvXTX(counter_row_output, counter_column_output)
Loop While counter_column_output < column_count_ir
Loop While counter_row_output < column_count_ir

'*** OUTPUTS MATRIX INV(XTY) ****
counter_row_output = 0
counter_column_output = 0
Do
counter_row_output = counter_row_output + 1
counter_column_output = 0
Do
counter_column_output = counter_column_output + 1
Worksheets("Matrix - XTY").Cells(counter_row_output, counter_column_output) = array_matrixXTY(counter_row_output, counter_column_output)
Loop While counter_column_output < column_count_dr
Loop While counter_row_output < column_count_ir

'*** OUTPUTS MATRIX B ****
counter_row_output = 0
counter_column_output = 0
Do
counter_row_output = counter_row_output + 1
counter_column_output = 0
Do
counter_column_output = counter_column_output + 1
Worksheets("Matrix - B").Cells(counter_row_output, counter_column_output) = array_matrixB(counter_row_output, counter_column_output)
Loop While counter_column_output < column_count_dr
Loop While counter_row_output < column_count_ir

'*** OUTPUTS MATRIX BT ****
counter_row_output = 0
counter_column_output = 0
Do
counter_row_output = counter_row_output + 1
counter_column_output = 0
Do
counter_column_output = counter_column_output + 1
Worksheets("Matrix - BT").Cells(counter_row_output, counter_column_output) = array_matrixBT(counter_row_output, counter_column_output)
Loop While counter_column_output < column_count_ir
Loop While counter_row_output < column_count_dr

'*** OUTPUTS MATRIX XB ****
counter_row_output = 0
counter_column_output = 0
Do
counter_row_output = counter_row_output + 1
counter_column_output = 0
Do
counter_column_output = counter_column_output + 1
Worksheets("Matrix - XB").Cells(counter_row_output, counter_column_output) = array_matrixXB(counter_row_output, counter_column_output)
Loop While counter_column_output < column_count_dr
Loop While counter_row_output < row_count_ir

'*** OUTPUTS MATRIX VCM ****
counter_row_output = 0
counter_column_output = 0
Do
counter_row_output = counter_row_output + 1
counter_column_output = 0
Do
counter_column_output = counter_column_output + 1
Worksheets("Matrix - VCM").Cells(counter_row_output, counter_column_output) = array_matrixVCM(counter_row_output, counter_column_output)
Loop While counter_column_output < column_count_ir
Loop While counter_row_output < column_count_ir

'*** OUTPUTS MATRIX REGRESSION TABLE ****
counter_row_output = 0
counter_column_output = 0
Worksheets.Add.Name = "Matrix - Regression Table"
Do
counter_row_output = counter_row_output + 1
counter_column_output = 0
Do
counter_column_output = counter_column_output + 1
Worksheets("Matrix - Regression Table").Cells(counter_row_output, counter_column_output) = array_matrixRegressionTable(counter_row_output, counter_column_output)
Loop While counter_column_output < 2
Loop While counter_row_output < column_count_ir

Application.ScreenUpdating = True

End Sub
Sub Statistic_Output(row_count_ir, column_count_ir, SSE, SSE_WHITE, SSR, SSR_WHITE, SST, _
SST_WHITE, DF, R2, R2_WHITE, ADJ_R2, SE, F, F_sig, F_WHITE, F_WHITE_sig, D_W, D_W_sig, _
F_RAMSEY, F_RAMSEY_sig, array_matrixY() As Double, array_matrixXB() As Double, _
array_matrixRegressionTable() As Double, array_Names() As String)

Dim counter_row_output As Integer, counter_column_output As Integer
Dim output, loop_break, ramsey As Integer
Dim output_range As Range
Dim worksheet_name As String

Set output_range = Range(Cells(1, 1), Cells(15 + column_count_ir, 6))

output = MsgBox("Would you like to output the regression statistics to a new worksheet?", vbYesNo, "Regression Output: Create New Sheet?")

If output = 7 Then
Set output_range = Application.InputBox("Select the worksheet and cell in which to output the summary.", Type:=8)
output_range = output_range.Resize(column_count_ir + 15, 6)

With output_range
.Columns(1).ColumnWidth = 16
.Columns(4).ColumnWidth = 32

.Cells(1, 1) = "SUMMARY OUTPUT"
.Cells(9, 1) = "ANOVA"
.Cells(15, 1) = "REGRESSION ESTIMATES"

'*** OUTPUTS REGRESSION STATISTICS ***
With .Cells(3, 1)
.Value = "Regression Statistics"
.Font.Italic = True
End With
With .Range(Cells(3, 1), Cells(3, 2))
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With

.Cells(4, 1) = "R-Square"
.Cells(4, 2) = R2
.Cells(6, 1) = "Standard Error"
.Cells(6, 2) = SE
.Cells(7, 1) = "Observations"
.Cells(7, 2) = row_count_ir

With .Range(Cells(7, 1), Cells(7, 2))
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With

'*** OUTPUTS BLUE CHECKS ***
With .Cells(3, 4)
.Value = "BLUE Checks"
.Font.Italic = True
End With
With .Range(Cells(3, 4), Cells(3, 6))
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With

With .Range(Cells(3, 5), Cells(3, 6))
.Font.Italic = True
.Cells(3, 5) = "Statistic"
.Cells(3, 6) = "P-Value"
End With

.Cells(4, 4) = "Heteroskedasticity: White Test"
.Cells(4, 5) = F_WHITE
.Cells(4, 6) = F_WHITE_sig
.Cells(5, 4) = "Multicollinearity: Durbin-Watson"
.Cells(5, 5) = D_W
.Cells(5, 6) = D_W_sig
.Cells(6, 4) = "Specification Error: Ramsey RESET"
.Cells(6, 5) = F_RAMSEY
.Cells(6, 6) = F_RAMSEY_sig

With .Range(Cells(7, 4), Cells(7, 6))
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With

'*** OUTPUTS ANOVA TABLE ***
With .Range(Cells(10, 1), Cells(10, 6))
.Font.Italic = True
.HorizontalAlignment = xlCenter
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With

.Cells(11, 1) = "Regression"
.Cells(12, 1) = "Residual"
.Cells(13, 1) = "Total"

.Cells(10, 2) = "df"
.Cells(11, 2) = column_count_ir - 1
.Cells(12, 2) = DF
.Cells(13, 2) = DF + column_count_ir - 1

.Cells(10, 3) = "SS"
.Cells(11, 3) = SSE
.Cells(12, 3) = SSR
.Cells(13, 3) = SST

.Cells(10, 4) = "MS"
.Cells(11, 4) = SSE / (column_count_ir - 1)
.Cells(12, 4) = SSR / DF

.Cells(10, 5) = "F"
.Cells(11, 5) = F

.Cells(10, 6) = "Signifance"
.Cells(11, 6) = F_sig

With .Range(Cells(13, 1), Cells(13, 6))
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With

'*** OUTPUTS Variable Names ****
With .Range(Cells(16, 1), Cells(16, 5))
.Font.Italic = True
.HorizontalAlignment = xlCenter
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With

.Cells(16, 2) = "Coefficients"
.Cells(16, 3) = "Standard Error"
.Cells(16, 4) = "t"
.Cells(16, 5) = "P value"

counter_row_output = 16
Do
counter_row_output = counter_row_output + 1
counter_column_output = 0
Do
counter_column_output = counter_column_output + 1
.Cells(counter_row_output, counter_column_output) = array_Names(counter_row_output - 16)
Loop While counter_column_output < 2
Loop While counter_row_output < column_count_ir + 16

'*** OUTPUTS Residuals ****
counter_row_output = 18 + column_count_ir
.Cells(counter_row_output, 1) = "RESIDUALS"
Do
counter_row_output = counter_row_output + 1
.Cells(counter_row_output, 1) = "e" & counter_row_output - (18 + column_count_ir)
.Cells(counter_row_output, 2) = array_matrixY(counter_row_output - (18 + column_count_ir), 1) - array_matrixXB(counter_row_output - (18 + column_count_ir), 1)
Loop While counter_row_output < row_count_ir + (18 + column_count_ir)

'*** OUTPUTS MATRIX REGRESSION TABLE ****
counter_row_output = 16
counter_column_output = 1
Do
counter_row_output = counter_row_output + 1
counter_column_output = 1
Do
counter_column_output = counter_column_output + 1
.Cells(counter_row_output, counter_column_output) = array_matrixRegressionTable(counter_row_output - 16, counter_column_output - 1)
Loop While counter_column_output < 5
Loop While counter_row_output < column_count_ir + 16

With .Range(Cells(column_count_ir + 16, 1), Cells(column_count_ir + 16, 5))
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With
End With
Application.ScreenUpdating = True
Else

worksheet_name = Application.InputBox("Enter the name of the worksheet to output the Regression Summary.", "Worksheet Name", Type:=2)

Do
loop_break = 0
If Len(worksheet_name) > 32 Then
worksheet_name = Application.InputBox("The worksheet name has exceeded the maximum length allowable (32 characters).  Please reenter.", "Error: Name Too Long", Type:=2)
loop_break = 1
End If

If InStr(1, worksheet_name, "*") <> 0 Or InStr(1, worksheet_name, "?") <> 0 Or InStr(1, worksheet_name, "\") <> 0 Or InStr(1, worksheet_name, "/") <> 0 Or InStr(1, worksheet_name, "[") <> 0 Or InStr(1, worksheet_name, "]") <> 0 Or InStr(1, worksheet_name, ":") <> 0 Or InStr(1, worksheet_name, "'") <> 0 Then
worksheet_name = Application.InputBox("The worksheet name cannot contain the characters ]'/*:\?[ .  Please reenter.", "Error: Invalid Character(s)", Type:=2)
loop_break = 1
End If

If Len(worksheet_name) = 0 Then
worksheet_name = "Statistical Output"
loop_break = 1
End If
Loop While loop_break = 1

Application.ScreenUpdating = False

With Worksheets(worksheet_name)
.Columns(1).ColumnWidth = 16
.Columns(4).ColumnWidth = 32

.Cells(1, 1) = "SUMMARY OUTPUT"
.Cells(9, 1) = "ANOVA"
.Cells(15, 1) = "REGRESSION ESTIMATES"

'*** OUTPUTS REGRESSION STATISTICS ***
With .Cells(3, 1)
.Value = "Regression Statistics"
.Font.Italic = True
End With
With .Range(Cells(3, 1), Cells(3, 2))
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With

.Cells(4, 1) = "R-Square"
.Cells(4, 2) = R2
.Cells(6, 1) = "Standard Error"
.Cells(6, 2) = SE
.Cells(7, 1) = "Observations"
.Cells(7, 2) = row_count_ir

With .Range(Cells(7, 1), Cells(7, 2))
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With

'*** OUTPUTS BLUE CHECKS ***
With .Cells(3, 4)
.Value = "BLUE Checks"
.Font.Italic = True
End With
With .Range(Cells(3, 4), Cells(3, 6))
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With

With .Range(Cells(3, 5), Cells(3, 6))
.Font.Italic = True
.Cells(1, 1) = "Statistic"
.Cells(1, 1) = "P-Value"
End With

.Cells(4, 4) = "Heteroskedasticity: White Test"
.Cells(4, 5) = F_WHITE
.Cells(4, 6) = F_WHITE_sig
.Cells(5, 4) = "Multicollinearity: Durbin-Watson"
.Cells(5, 5) = "NOT YET WORKING"
'.Cells(5, 5) = D_W
'.Cells(5, 6) = D_W_sig
.Cells(6, 4) = "Specification Error: Ramsey RESET"
.Cells(6, 5) = "NOT YET WORKING"
'.Cells(6, 5) = F_RAMSEY
'.Cells(6, 6) = F_RAMSEY_sig

With .Range(Cells(6, 4), Cells(6, 6))
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With

'*** OUTPUTS ANOVA TABLE ***
With .Range(Cells(10, 1), Cells(10, 6))
.Font.Italic = True
.HorizontalAlignment = xlCenter
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With

.Cells(11, 1) = "Regression"
.Cells(12, 1) = "Residual"
.Cells(13, 1) = "Total"

.Cells(10, 2) = "df"
.Cells(11, 2) = column_count_ir - 1
.Cells(12, 2) = DF
.Cells(13, 2) = DF + column_count_ir - 1

.Cells(10, 3) = "SS"
.Cells(11, 3) = SSE
.Cells(12, 3) = SSR
.Cells(13, 3) = SST

.Cells(10, 4) = "MS"
.Cells(11, 4) = SSE / (column_count_ir - 1)
.Cells(12, 4) = SSR / DF

.Cells(10, 5) = "F"
.Cells(11, 5) = F

.Cells(10, 6) = "Signifance"
.Cells(11, 6) = F_sig

With .Range(Cells(13, 1), Cells(13, 6))
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With

'*** OUTPUTS Variable Names ****
With .Range(Cells(16, 1), Cells(16, 5))
.Font.Italic = True
.HorizontalAlignment = xlCenter
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With

.Cells(16, 2) = "Coefficients"
.Cells(16, 3) = "Standard Error"
.Cells(16, 4) = "t"
.Cells(16, 5) = "P value"

counter_row_output = 16
counter_column_output = 0
Do
counter_row_output = counter_row_output + 1
counter_column_output = 0
Do
counter_column_output = counter_column_output + 1
.Cells(counter_row_output, counter_column_output) = array_Names(counter_row_output - 16)
Loop While counter_column_output < 2
Loop While counter_row_output < column_count_ir + 16

'*** OUTPUTS Residuals ****
counter_row_output = 18 + column_count_ir
.Cells(counter_row_output, 1) = "RESIDUALS"
Do
counter_row_output = counter_row_output + 1
.Cells(counter_row_output, 1) = "e" & counter_row_output - (18 + column_count_ir)
.Cells(counter_row_output, 2) = array_matrixY(counter_row_output - (18 + column_count_ir), 1) - array_matrixXB(counter_row_output - (18 + column_count_ir), 1)
Loop While counter_row_output < row_count_ir + (18 + column_count_ir)

'*** OUTPUTS MATRIX REGRESSION TABLE ****
counter_row_output = 16
counter_column_output = 1
Do
counter_row_output = counter_row_output + 1
counter_column_output = 1
Do
counter_column_output = counter_column_output + 1
.Cells(counter_row_output, counter_column_output) = array_matrixRegressionTable(counter_row_output - 16, counter_column_output - 1)
Loop While counter_column_output < 5
Loop While counter_row_output < column_count_ir + 16

With .Range(Cells(column_count_ir + 16, 1), Cells(column_count_ir + 16, 5))
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With
End With

Application.ScreenUpdating = True
End If

ramsey = MsgBox("Ramsey RESET Test uses a non-linear squared form.  In the future, this test will be user-defined.", vbOKOnly)

End Sub``````

#### acunnold

##### New Member
I need to do my own because I then need to change it such that it doesn't fit to a line, but two lines with one of the variables being maxed out in the second region. This needs to be changed within the regression calculation rather than just in the inputs to the regression, hence needed to write my own regression program.

Thanks,
Anne-Marie

#### acunnold

##### New Member
Btw what did you mean by "so long as i picked the correct dimensions for the array"? which array were you refering to?

Thanks!

Replies
8
Views
289
Replies
8
Views
186
Replies
0
Views
34
Replies
7
Views
93
Replies
1
Views
77