Option Explicit
Option Base 1
'===============================================================================================
'CalcSE Function
'
'written by Wayne Chang
'last update Nov-1-2013
'Returns: standard OLS, robust/White('80), Newey-West('87), or Hansen-Hodrick('80) standard error
'Arguments:
' -Dependent variable Y obs as range/array
' -Independent variable X obs as range/array (can only handle single variable)
' -Lag is number of autocorrelated lags, ie k-1 in Cochrane('05) notation (only necessary for NW or HH errors)
' -Type of user-specified standard error as string ("OLS", "White", "NW", or "HH")
'Notes:
' -Blanks within the data should be ok since ignored by Excel functions and will also not contribute to XXUU
' -Degree of freedom adjustments (2) necessary for OLS given exact, finite distribution and not necessary under
' asymototic theory (White, NW, HH) although Cameron, Trivedi ('05, p75) mentions that White s.e. often have
' degree of freedom adjustments in practice which yields favorable results under simulation studies
' -HH standard errors may be negative since unlike Newey-West, the XXUU matrix is not positive semidefinite
'===============================================================================================
Public Function CalcSE(VarY As Variant, VarX As Variant, StError As String, Optional Lag As Variant) As Variant
' check to see if X, Y variables have the same number of observations
If WorksheetFunction.Count(VarX) <> WorksheetFunction.Count(VarY) Then
CalcSE = CVErr(xlErrRef)
Exit Function
End If
' check to see if lag is provided by user who selects Newey-West or Hansen-Hodrick erros
If StError = "NW" Or StError = "HH" Then
If IsMissing(Lag) = True Then
CalcSE = CVErr(xlErrRef)
Exit Function
End If
End If
' define variables for key parameters
Dim Obs As Integer, RegCons As Double, XMean As Double, RegBeta As Double
Obs = WorksheetFunction.Count(VarX)
XMean = WorksheetFunction.Average(VarX)
RegBeta = WorksheetFunction.Slope(VarY, VarX) 'regression beta
RegCons = WorksheetFunction.Intercept(VarY, VarX) 'regression constant
' define arrays to store intermediate data
Dim Resid() As Double, XDemeaned() As Double, XX() As Double, XXUU() As Double
ReDim Resid(Obs)
ReDim XDemeaned(Obs)
ReDim XX(Obs)
ReDim XXUU(Obs) 'includes lead/lags for Newey-West and Hansen-Hodrick
' define for-loop counters
Dim cntr As Integer, residcntr As Integer
' preliminary calcs of residual and demeaned XX
For cntr = 1 To Obs
Resid(cntr) = VarY(cntr) - VarX(cntr) * RegBeta - RegCons 'generate residuals
XDemeaned(cntr) = VarX(cntr) - XMean 'must demean x to get correct stats
XX(cntr) = XDemeaned(cntr) ^ 2
Next cntr
' standard error calculation
Select Case StError
Case "OLS"
CalcSE = Sqr(WorksheetFunction.Var_P(Resid) / WorksheetFunction.Var_P(VarX) / (Obs - 2))
Case "White"
For cntr = 1 To Obs
XXUU(cntr) = (Resid(cntr) ^ 2) * XX(cntr)
Next cntr
CalcSE = Sqr(WorksheetFunction.Average(XXUU) / (WorksheetFunction.Average(XX) ^ 2) / Obs)
Case "NW" 'Newey-West (has weights)g
For cntr = 1 To Obs 'sum the lead/lag terms for each obs
For residcntr = WorksheetFunction.Max(1, cntr - Lag) To WorksheetFunction.Min(cntr + Lag, Obs)
XXUU(cntr) = XXUU(cntr) + (1 - Abs(cntr - residcntr) / (Lag + 1)) _
* Resid(residcntr) * Resid(cntr) * XDemeaned(cntr) * XDemeaned(residcntr)
Next residcntr
Next cntr
CalcSE = Sqr(WorksheetFunction.Average(XXUU) / (WorksheetFunction.Average(XX) ^ 2) / Obs)
Case "HH" 'Hansen-Hodrick (no weights)
For cntr = 1 To Obs 'sum the lead/lag terms for each obs
For residcntr = WorksheetFunction.Max(1, cntr - Lag) To WorksheetFunction.Min(cntr + Lag, Obs)
XXUU(cntr) = XXUU(cntr) + Resid(residcntr) * Resid(cntr) * XDemeaned(cntr) * XDemeaned(residcntr)
Next residcntr
Next cntr
If WorksheetFunction.Sum(XXUU) >= 0 Then
CalcSE = Sqr(WorksheetFunction.Average(XXUU) / (WorksheetFunction.Average(XX) ^ 2) / Obs)
Else
CalcSE = CVErr(xlErrNum) 'return error if HH s.e. negative
End If
Case Else
CalcSE = CVErr(xlErrRef) 'return error if user specifies improper S.E. type
End Select
End Function