'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'''''''''''''
''''''''''''^ INSERT ^''''''''''''
'''''''''''^ xMACROBUNDLE ^'''''''''''
''''''''''''^ TOOLBAR ^''''''''''''
'''''''''''''^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'''''''''''''
''''''''''''''''''''''''''''''''''''''''''' (c) R. de Levie
'''''''''''''''''''''''''''''''''''''''' v 5.5, May 1, 2005
' PURPOSE:
' This subroutine places an extra toolbar in the Excel
' spreadsheet in order to facilitate access to the custom
' extended precision macros in the xMacroBundle. These
' macros will only run if xnumbers.dll has been installed
' in Windows and is referenced in Excel, see below under
' installation of Xnumbers.dll. For a tutorial on the use
' of Xnumbers.dll see Xnumbers_DLL_Ref, or my web site at
'
' INSTALLATION OF XNUMBERS.DLL
' You will need to have an unzip routine handy, because the
' download is a zip file, and an Adobe Acrobat reader,
' as the documentation comes as a pdf (portable document
' format) file. Both of these can be freely downloaded from
' the web, and should already be on your desktop as stan-
' dard tools.
' Here is how you can install the dynamic link library. (A
' specific location is selected here for your convenience,
' but you can of course place it somewhere else, in which
' case you should make the corresponding changes in what
' follows.) Go to the website
' foxes, select Downloads, and download the xnumberdll.zip
' to your desktop. Unzip the file, and store its three com-
' ponents, readme, xnumbers.dll, and Xnumbers_DLL_Ref, on
' the desktop. The readme file contains nothing important:
' read it and either discard or store somewhere. The refe-
' rence file, Xnumbers_DLL_Ref, is very worthwhile and has
' many useful details. You may want to print it out, but
' please do that later, because it is a 115-page tome. For
' now we will focus on xnumber.dll.
' On your desktop, click on My Computer ð Local Disk (C:)
' > Program Files > Microsoft Office > Office ð Library.
' Then press File > New > Folder, and change the name of
' the so generated folder from New Folder to Xnumbers, then
' open that file (which, as a new file, should be empty).
' If necessary, reduce the space taken up by this folder
' and/or move it, so that you can find xnumbers.dll on the
' desktop. Click on xnumbers.dll, copy or drag it into the
' open folder, and close the folder. Now, xnumbers.dll is
' stored safely, and presumably in good company, next to
' Solver.
' In order to make sure that Excel can find it, open Excel,
' go to the Visual Basic Editor with Tools > Macro > Visual
' Basic Editor or, faster, with Alt+F11 (on the Mac: Opt+
' F11), and then, in the VBEditor menu bar, select Tools >
' References. This will display the dialog box for the VBA
' Project. Click on Browse, select Files of type: Type
' Libraries (*.olb;*.tlb;*.dll), in the Add Reference
' dialog box go to My Computer > Local Disk (C:) > Program
' Files > Microsoft Office > Office > Library > Xnumbers,
' open the file, and in the File name window type its name,
' xnumbers.dll. Click Open it, which will bring you back to
' the References - VBA Project dialog box. Now use the
' Priority Up button to ease the corresponding label,
' Multiprecision Arithmetic Library, up the list so that it
' is contiguous with the other tick-marked items. Click OK.
' From now on, Excel will know where to find xnumbers.dll.
' SUBROUTINES:
' The xMacroBundle includes copies of all the subroutines
' used by these xmacros: xTranspose, xMultiply, xVMultiply,
' and xInvert.
' LIMITATIONS:
' This toolbar will work by itself, or in combination with
' the regular (double-precision) MacroBundle toolbar. The
' two sets of macros don't interact, but be careful to keep
' them apart in your mind, because their names differ only
' by the prefix x for extended precision.
' This toolbar works in Excel 97 and in more recent ver-
' sions of Excel. It will not work in Excel 95 or earlier
' versions of Excel because these handled toolbars diffe-
' rently. Of course, the extended precision macros require
' the installation of xnumbers.dll, which will only run
' under Windows NT, 2000, XP or a more recent version of
' Windows.
Sub InsertxMBToolbar()
On Error GoTo Handler
Dim a
a = 1
Dim MP As New Xnumbers
a = MP.xAdd(a, a)
Set MP = Nothing
Dim TBar As CommandBar
Dim Button2 As CommandBarPopup
Dim Button20 As CommandBarButton
Dim Button21 As CommandBarButton
Dim Button3 As CommandBarPopup
Dim Button30 As CommandBarButton
Dim Button31 As CommandBarButton
Dim Button6 As CommandBarPopup
Dim Button60 As CommandBarButton
Dim Button61 As CommandBarButton
Dim Button7 As CommandBarPopup
Dim Button70 As CommandBarButton
Dim Button71 As CommandBarButton
Dim Button10 As CommandBarPopup
Dim Button100 As CommandBarButton
Dim Button101 As CommandBarButton
' Delete earlier version of MacroBundle,
' if existing, to prevent conflicts
On Error Resume Next
CommandBars("xMacroBundle").Delete
' Create a commandbar
Set TBar = CommandBars.Add
With TBar
.Name = "xMacroBundle"
.Position = msoBarTop
.Visible = True
End With
' Create Button2 for &xLS
Set Button2 = CommandBars("xMacroBundle").Controls _
.Add(Type:=msoControlPopup)
With Button2
.Caption = "&x&LS"
.TooltipText = "Highlight array" & Chr(13) & _
"before pressing" & Chr(13) & "xLS0 or xLS1"
.BeginGroup = True
End With
' Create submenus for xLS&0 and xLS&1 respectively
Set Button20 = Button2.Controls.Add(Type:=msoControlButton)
With Button20
.Caption = "&xLS&0"
.Style = msoButtonCaption
.OnAction = "xLS0"
End With
Set Button21 = Button2.Controls.Add(Type:=msoControlButton)
With Button21
.Caption = "&xLS&1"
.Style = msoButtonCaption
.OnAction = "xLS1"
End With
' Create Button3 for xWLS
Set Button3 = CommandBars("xMacroBundle").Controls _
.Add(Type:=msoControlPopup)
Button3.Caption = "x&WLS"
Button3.TooltipText = "Highlight array" & Chr(13) & _
"before pressing" & Chr(13) & "xWLS0 or xWLS1"
' Create submenus for xWLS&0 and xWLS&1 respectively
Set Button30 = Button3.Controls.Add(Type:=msoControlButton)
Button30.Caption = "xWLS&0"
Button30.OnAction = "xWLS0"
Set Button31 = Button3.Controls.Add(Type:=msoControlButton)
Button31.Caption = "xWLS&1"
Button31.OnAction = "xWLS1"
' Create Button6 for xLSPol&y
Set Button6 = CommandBars("xMacroBundle").Controls _
.Add(Type:=msoControlPopup)
Button6.Caption = "xLSPol&y"
Button6.TooltipText = "Highlight array" & Chr(13) & _
"before pressing" & Chr(13) & "xLSPoly0 or xLSPoly1"
' Create submenus for xLSPoly&0 and xLSPoly&1 respectively
Set Button60 = Button6.Controls.Add(Type:=msoControlButton)
Button60.Caption = "xLSPoly&0"
Button60.OnAction = "xLSPoly0"
Set Button61 = Button6.Controls.Add(Type:=msoControlButton)
Button61.Caption = "xLSPoly&1"
Button61.OnAction = "xLSPoly1"
' Create Button7 for x&Ortho
Set Button7 = CommandBars("xMacroBundle").Controls _
.Add(Type:=msoControlPopup)
Button7.Caption = "&xOrtho"
Button7.BeginGroup = True
Button7.TooltipText = "Highlight array" & Chr(13) & _
"before pressing" & Chr(13) & "xOrtho0 or xOrtho1"
' Create submenus for xOrtho&0 and xOrtho&1 respectively
Set Button70 = Button7.Controls.Add(Type:=msoControlButton)
Button70.Caption = "xOrtho&0"
Button70.OnAction = "xOrtho0"
Set Button71 = Button7.Controls.Add(Type:=msoControlButton)
Button71.Caption = "xOrtho&1"
Button71.OnAction = "xOrtho1"
' Create Button10 for x&FT
Set Button10 = CommandBars("xMacroBundle").Controls _
.Add(Type:=msoControlPopup)
With Button10
.Caption = "x&FT"
.BeginGroup = True
.TooltipText = "Highlight array" & Chr(13) & _
"before pressing" & Chr(13) & "xForwardFT or" & _
Chr(13) & "xInverseFT"
End With
' Create submenus for &ForwardFT
' and &InverseFT respectively
Set Button100 = Button10.Controls _
.Add(Type:=msoControlButton)
With Button100
.Caption = "x&ForwardFT"
.Style = msoButtonCaption
.OnAction = "xForwardFT"
End With
Set Button101 = Button10.Controls _
.Add(Type:=msoControlButton)
With Button101
.Caption = "x&InverseFT"
.Style = msoButtonCaption
.OnAction = "xInverseFT"
End With
Exit Sub
Handler:
MsgBox "The xnumbers.dll is not operative"
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub RemovexMBToolbar()
On Error Resume Next
CommandBars("xMacroBundle").Delete
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''^^^^^^^^^^^^^^^^^^^^^^^^^''''''''''''''''
'''''''''''''''''^ ^'''''''''''''''
''''''''''''''''^ xLEAST SQUARES ^''''''''''''''
'''''''''''''''''^ ^'''''''''''''''
''''''''''''''''''^^^^^^^^^^^^^^^^^^^^^^^^^''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''' (c) R. de Levie
'''''''''''''''''''''''''''''''''''''''' v 5.5, May 1, 2005
' This is the extended-precision version of LS. If there
' are three or more input columns, it assumes that a power
' series in x is used, and it computes this internally. If
' that is inappropriate, comment out the seven lines of
' code in the paragraph labeled INTERNAL SERIES CALCULATION
Sub xLS0() ' for an unweighted least squares fit
' through the origin at extended precision
Dim p
p = 0
Call xLeastSquares(p)
End Sub
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
Sub xLS1() ' for a general unweighted least
' squares fit at extended precision
Dim p
p = 1
Call xLeastSquares(p)
End Sub
Sub xLeastSquares(p)
Dim MP As New Xnumbers
Dim cMax As Integer, Delta As Integer, denom As Integer
Dim j As Integer, jj As Integer, m As Integer
Dim n As Integer, q As Integer, s As Integer
Dim i As Long
Dim aa, AC, Answer, hAnswer, jAnswer, NumPrecision
Dim Ratio, rMax, Root, SSR, StDevF, u, varY
Dim myRange As Range
Dim bArray, btArray, btqArray, DataArray, lccArray
Dim outputArray, vArray, v0Array, pArray, piArray
Dim qArray, XArray, xtArray, YArray, ytArray, ytyArray
Dim DgtMax
s = 0
' Select the desired numerical precision. The default
' value is 30, which yields quadruple precision. If
' you don't want any other precision, and want to avoid
' having to respond to an input box every time you use
' this macro, simply comment out the instructions
' between this and the next comment line.
TryAgain:
NumPrecision = InputBox("Enter the desired numerical " & _
"precision," & vbCr & "in number of decimals, " & _
"up to 200." & vbCr & vbCr & "Click OK for the " & _
"default value, 30," & vbCr & "i.e., for quadruple " & _
"precision.", "Numerical precision", 30)
If Val(NumPrecision) > 200 Then
MsgBox "The precision can be no larger than 200. Try again"
GoTo TryAgain
End If
DgtMax = Val(NumPrecision)
Delta = 2 - DgtMax
' Determination of the array size:
With MP
.DigitsMax = DgtMax
Begin:
rMax = Selection.Rows.count
cMax = Selection.Columns.count
u = 1
' If area was not highlighted
If rMax = 1 And cMax = 1 Then
hAnswer = MsgBox("You forgot to highlight" _
& Chr(13) & "the block of input data." _
& Chr(13) & "Do you want to do so now?" _
, vbYesNo, "Least Squares Fit")
If hAnswer = vbNo Then End
If hAnswer = vbYes Then
Set myRange = Application.InputBox(Prompt:= _
"The input data are located in:", Type:=8)
myRange.Select
End If
GoTo Begin
End If
' Check that the number of columns is at least 2:
If cMax < 2 Then
MsgBox "There must be at least two columns," & _
Chr(13) & "one for Y, and one or more for X.", _
, "Least Squares Fit"
End
End If
' Check that there are more data than coefficients :
If rMax - cMax - p + 1 <= 0 Then
MsgBox "With " & rMax & " data, LS" & p & " can only deter-" & _
Chr(13) & "mine " & rMax - 1 & " least squares coefficients." & _
Chr(13) & Chr(13) & "Add more data, or reduce the re-" & _
Chr(13) & "quested number of coefficients."
End
End If
' Dimension the arrays:
ReDim YArray(1 To rMax, 1 To 1)
ReDim XArray(1 To rMax, 1 To cMax)
ReDim ytArray(1 To 1, 1 To rMax)
ReDim ytyArray(1 To 1, 1 To 1)
ReDim xtArray(1 To cMax, 1 To rMax)
ReDim pArray(1 To cMax, 1 To cMax)
ReDim piArray(1 To cMax, 1 To cMax)
ReDim qArray(1 To cMax, 1 To 1)
ReDim bArray(1 To cMax, 1 To 1)
ReDim btArray(1 To 1, 1 To cMax)
ReDim btqArray(1 To 1, 1 To 1)
ReDim vArray(1 To cMax, 1 To cMax)
ReDim v0Array(1 To cMax - 1 + p, 1 To cMax - 1 + p)
ReDim lccArray(1 To cMax, 1 To cMax)
' Read the dataArray, then fill yArray and xArray.
DataArray = Selection.Value
For i = 1 To rMax
YArray(i, 1) = DataArray(i, 1)
Next i
For i = 1 To rMax
If IsEmpty(DataArray(i, 1)) Then
MsgBox "Y-value(s) missing", , "Least Squares Fit"
End
End If
Next i
For j = 2 To cMax
For i = 1 To rMax
If IsEmpty(DataArray(i, j)) Then
MsgBox "X-value(s) missing", , "Least Squares Fit"
End
End If
Next i
Next j
' Fill the first column of xArray with zeroes (for p = 0)
' or ones (for p = 1), the rest with the data in the
' x-column(s)
For i = 1 To rMax
XArray(i, 1) = CDbl(p)
Next i
For j = 2 To cMax
For i = 1 To rMax
XArray(i, j) = DataArray(i, j)
Next i
Next j
' Select whether you want to replace the input data beyond
' the first two columns by a power series in x, or use the
' existing input data. If you select Yes, the columns
' beyond the second will be filled with x^3, x^4, etc. for
' as many columns as there are on the spreadsheet. The
' advantage is that these powers will be computed with
' extended precision. The disadvantage is that incorrect
' results will be obtained when the input data are multi-
' variate, or form anything other than a regular power
' series in x.
If cMax > 5 Then
sAnswer = _
MsgBox(" Do you want to compute the data in the" & _
vbCr & "input beyond the second column as a regular" & _
vbCr & "power series in x, with extended precision?" & _
vbCr & " If so, press Yes." & vbCr & _
vbCr & " If the data in the various x-columns" & _
vbCr & " do not follow a regular power series," & _
vbCr & " or are multivariate, press No.", _
vbYesNo, "Compute power series?")
If sAnswer = vbYes Then
s = 1
For j = 3 To cMax
For i = 1 To rMax
XArray(i, j) = .xPow(DataArray(i, 2), j - 1)
Next i
Next j
End If
End If
' Compute b = (X' X)" X' Y , where ' or t denote
' transposition, and " or i indicate inversion
' The various arrays and their dimensions (rows,
' columns) are:
' Y = yArray ( rmax, 1)
' X = xArray ( rmax, cmax)
' X' = xtArray ( cmax, rmax)
' X' X = pArray ( cmax, cmax)
' (X' X)" = piArray ( cmax, cmax)
' X' Y = qArray ( cmax, 1)
' b = bArray ( cmax, 1)
Call xTranspose(XArray, rMax, cMax, xtArray, DgtMax)
Call xMultiply(xtArray, cMax, rMax, XArray, cMax, pArray, _
DgtMax)
Call xInvert(pArray, cMax, piArray, DgtMax)
Call xMultiply(xtArray, cMax, rMax, YArray, 1, qArray, _
DgtMax)
Call xMultiply(piArray, cMax, cMax, qArray, 1, bArray, _
DgtMax)
' Check against overwriting spreadsheet data
m = 0
If (p = 0 And cMax = 2) Then
For i = 1 To 3
Selection.Offset(1, 0).Select
outputArray = Selection.Value
For j = 1 To cMax
If IsEmpty(outputArray(rMax, j)) Then
m = m
Else
m = m + 1
End If
Next j
Next i
Selection.Offset(-3, 0).Select
If m > 0 Then Answer = MsgBox("There are data in the " _
& "three lines below the" & Chr(13) & _
"input data array. " & "Can they be overwritten?", _
vbYesNo, "Overwrite?")
If Answer = vbNo Then End
Else
For i = 1 To 2 + p + cMax
Selection.Offset(1, 0).Select
outputArray = Selection.Value
For j = 1 To cMax
If IsEmpty(outputArray(rMax, j)) Then
m = m
Else
m = m + 1
End If
Next j
Next i
Selection.Offset(-2 - p - cMax, 0).Select
If m > 0 Then Answer = MsgBox("There are data in the " _
& 2 + p + cMax & " lines below the" & Chr(13) & _
"input data array. " & "Can they be overwritten?", _
vbYesNo, "Overwrite?")
If Answer = vbNo Then End
End If
' The additional arrays and their dimensions (rows,
' columns) are:
' Y' = ytArray ( 1, rmax)
' Y' Y = ytyArray ( 1, 1)
' b' = btArray ( 1, cmax)
' b' X' Y = btqArray ( 1, 1)
Call xTranspose(YArray, rMax, 1, ytArray, DgtMax)
Call xTranspose(bArray, cMax, 1, btArray, DgtMax)
Call xMultiply(ytArray, 1, rMax, YArray, 1, ytyArray, DgtMax)
Call xMultiply(btArray, 1, cMax, qArray, 1, btqArray, DgtMax)
' Calculate SSR = Y'Y - b'X'Y; then the variance
' of y as varY = SSR/(rMax-cMax-p+1); and vArray,
' the covariance matrix, as V = (X'X)" times varY.
SSR = .xSub(ytyArray(1, 1), btqArray(1, 1))
denom = rMax - cMax - p + 1
varY = .xDiv(SSR, denom)
StDevF = .xSqr(.xAbs(varY))
For i = 1 To cMax
For j = 1 To cMax
vArray(i, j) = .xMult(varY, piArray(i, j))
Next j
Next i
Application.ScreenUpdating = False
ActiveCell.Offset(rMax, 0).Select
' Prepare the output format
For j = 1 To cMax
ActiveCell.Font.Bold = True
ActiveCell.Font.Italic = True
ActiveCell.Font.ColorIndex = 1
ActiveCell.Offset(0, 1).Select
Next j
ActiveCell.Offset(1, -cMax).Select
If (p = 0 And cMax = 2) Then
For i = 1 To 2
For j = 1 To cMax
ActiveCell.Font.Bold = False
ActiveCell.Font.Italic = True
ActiveCell.Font.ColorIndex = 1
ActiveCell.Offset(0, 1).Select
Next j
ActiveCell.Offset(1, -cMax).Select
Next i
ActiveCell.Offset(-3, 0).Select
Else
For i = 1 To 1 + p + cMax
For j = 1 To cMax
ActiveCell.Font.Bold = False
ActiveCell.Font.Italic = True
ActiveCell.Font.ColorIndex = 1
ActiveCell.NumberFormat = "General"
ActiveCell.Offset(0, 1).Select
Next j
ActiveCell.Offset(1, -cMax).Select
Next i
ActiveCell.Offset(-2 - p - cMax, 0).Select
End If
' Prepare the output labels, suppressing them when space
' for them is unavailable or data will be overwritten
aa = ActiveCell.Address
AC = Mid(aa, 2, 1)
If (AC = "A" And p = 1) Then GoTo NoLabel
ActiveCell.Offset(0, -p).Select
If p = 1 Then
If (IsEmpty(ActiveCell) Or ActiveCell.Value = "Coeff:") _
Then
GoTo Step1
Else
ActiveCell.Offset(0, p).Select
GoTo NoLabel
End If
End If
Step1:
With ActiveCell
.Value = "Coeff:"
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.HorizontalAlignment = xlRight
End With
ActiveCell.Offset(1, 0).Select
If p = 1 Then
If (IsEmpty(ActiveCell) Or ActiveCell.Value = "StDev:") _
Then
GoTo Step2
Else
ActiveCell.Offset(-1, p).Select
GoTo NoLabel
End If
End If
Step2:
With ActiveCell
.Value = "StDev:"
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.HorizontalAlignment = xlRight
End With
ActiveCell.Offset(1, 0).Select
If p = 1 Then
If (IsEmpty(ActiveCell) Or ActiveCell.Value = "Sf:") _
Then
GoTo Step3
Else
ActiveCell.Offset(-1, p).Select
GoTo NoLabel
End If
End If
Step3:
With ActiveCell
.Value = "Sf:"
.Font.Bold = False
.Font.Italic = True
.Font.ColorIndex = 1
.HorizontalAlignment = xlRight
End With
ActiveCell.Offset(-1, p).Select
If p = 0 And cMax = 2 Then
ActiveCell.Offset(-1, p).Select
GoTo NoLabel
End If
ActiveCell.Offset(3, -p).Select
If p = 1 Then
If (IsEmpty(ActiveCell) Or ActiveCell.Value = "CM:") Then
GoTo Step4
Else
ActiveCell.Offset(-3, p).Select
GoTo NoLabel
End If
End If
Step4:
ActiveCell.Offset(-1, 0).Select
With ActiveCell
.Value = "CM:"
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 5
.HorizontalAlignment = xlRight
End With
ActiveCell.Offset(-3, p).Select
NoLabel:
ActiveCell.Offset(0, 1 - p).Select
For j = 2 - p To cMax
ActiveCell.Value = bArray(j, 1)
ActiveCell.NumberFormat = "General"
ActiveCell.Offset(0, 1).Select
Next j
ActiveCell.Offset(1, 1 - p - cMax).Select
q = 0
For j = 2 - p To cMax
ActiveCell.Font.ColorIndex = 3
ActiveCell.NumberFormat = "General"
If .xComp(vArray(j, j), 0) < 0 Then
ActiveCell.Value = "var < 0"
ActiveCell.Font.Bold = True
q = q + 1
Else
ActiveCell.Value = .xSqr(vArray(j, j))
Ratio = .xDiv(.xAbs(bArray(j, 1)), .xSqr(vArray(j, j)))
If .xComp(Ratio, 1) = 1 Then _
ActiveCell.Font.ColorIndex = 16
If .xComp(Ratio, 5) = 1 Then _
ActiveCell.Font.ColorIndex = 10
End If
ActiveCell.Offset(0, 1).Select
Next j
' Write the standard deviation of the fit to the function
ActiveCell.Offset(1, 1 - p - cMax).Select
ActiveCell.Interior.ColorIndex = xlNone
ActiveCell.NumberFormat = "General"
Selection.Value = StDevF
' Identify the macro used
ActiveCell.Offset(0, 2).Select
ActiveCell.Value = ""
ActiveCell.Interior.ColorIndex = xlNone
ActiveCell.Offset(0, -1).Select
If p = 0 And cMax = 2 Then ActiveCell.Offset(1, -1).Select
ActiveCell.Value = "xLS" & p
ActiveCell.Font.Bold = True
ActiveCell.Font.Italic = False
ActiveCell.Font.ColorIndex = 5
ActiveCell.HorizontalAlignment = xlCenter
ActiveCell.Interior.ColorIndex = 34
ActiveCell.ClearComments
ActiveCell.AddComment
ActiveCell.Comment.Visible = False
If s = 0 Then ActiveCell.Comment.Text Text:= _
"macro = xLS" & p & Chr(10) & _
"numerical precision = " & DgtMax & Chr(10) & _
"x used as shown on" & Chr(10) & _
" spreadsheet" & Chr(10) & _
Date & ", " & Time
If s = 1 Then ActiveCell.Comment.Text Text:= _
"macro = xLS" & p & Chr(10) & _
"numerical precision = " & DgtMax & Chr(10) & _
"x power series computed" & Chr(10) & _
"date = " & Date & Chr(10) & "time = " & Time
If p = 0 And cMax = 2 Then ActiveCell.Offset(1, -1).Select
ActiveCell.Offset(0, -1).Select
' Write the covariance matrix
If p = 0 And cMax = 2 Then GoTo LastLine
ActiveCell.Offset(1, 0).Select
For i = 2 - p To cMax
For j = 2 - p To cMax
ActiveCell.Value = vArray(i, j)
ActiveCell.Font.ColorIndex = 5
ActiveCell.NumberFormat = "General"
ActiveCell.Offset(0, 1).Select
Next j
ActiveCell.Offset(1, 1 - p - cMax).Select
Next i
Application.ScreenUpdating = True
' Provide as optional output the array of linear
' correlation coefficients. The user specifies
' the cell block in which to write this array
If p = 0 And cMax = 2 Then GoTo LastLine
jAnswer = MsgBox("Do you want to see the " _