I was trying to make sense of ByVal and ByRef and passing arguments from long to double using the ByVal keyword.
I noticed that VBA gave me the incorrect answer for the value of y squared. It does work when y (i in my sub) is a whole number.
In the below example I had i = 22.5.
The spreadsheet gave me 506.25.
My function gave me 484.
I thought both long and double support decimals.
Sub automation_test()
Dim i As Long
Dim j As Long
Dim x As Long
Dim ans As Long
i = Range("B1")
j = Range("B2")
x = Range("B3")
ans = my_model(i, j, x)
Range("B4").Value = ans
End Sub
Function my_model(ByVal y As Double, ByVal m As Double, ByVal q As Double) As Double
' my_model = (y ^ 2) * (m ^ 3) * (q ^ 1 / 2)
my_model = y ^ 2
End Function
You must declare all used variables As Double (or As Single, depending on the maximum value to be used).
Long variables do not accept decimals.
The difference is exactly the one coming from rounding (down):
22.5^2 = 506.25
22^2 = 484
Related
Trying to debug. My best guess is the array indexing is a problem.
Public Function CFR(df(), x As Double, t As Integer) As Double
Dim i, y As Integer
Dim discount()
Dim nom, denom As Double
ReDim discount(t) As Double
y = 1
For i = UBound(df, 1) + 1 To t
discount(i) = df(UBound(df, 1)) * (x ^ y)
y = y + 1
Next I
nom = (1 - df(UBound(df)) * x ^ (t - UBound(df)))
denom = Application.WorksheetFunction.Sum(df) + Application.WorksheetFunction.Sum(discount)
CFR = nom / denim
End Function
you should really use Option Explicit:
Option Explicit
Public Function CFR(df(), x As Double, t As Integer) As Double
Dim i As Long, y As Integer
Dim discount() As Double
Dim nom, denom As Double
ReDim discount(t) As Double
y = 1
For i = UBound(df, 1) + 1 To t
discount(i) = df(UBound(df, 1)) * (x ^ y)
y = y + 1
Next i
nom = (1 - df(UBound(df)) * x ^ (t - UBound(df)))
denom = Application.WorksheetFunction.Sum(df) + Application.WorksheetFunction.Sum(discount)
CFR = nom / denom
End Function
The issues were
1) denim instad of denom
which the use of Option Explicit would found you out immediatley
2) Dim discount()
Since VBA assumes implicit Variant type for all not explicitly declared variables, and that makes it collidw with subsequent ReDim discount(t) As Double since the Redim() statement cannot change the type of the array
3) point 2 explanation is relevant for a minor issue (not blocking the code in this case):
Dim i, y As Integer
is actually read as:
Dim i As Variant, y As Integer
If you want i to be of integer type you have to code:
Dim i As Integer, y As Integer
I am writing a vba code to calculate the interests paid between two periods
I have written this code but it always give me back the value 0.
Function interests_paid_between(rate As Double, firstPer As Integer, lastPer As Integer, NPER As Integer, PV As Double) As Variant
Dim FutureValue As Double
FutureValue = InputBox("What is the future value of the loan? (if it is 0 put 0 else the value)")
Dim i As Integer
For i = firstPer To lastPer
InterestPaid = InterestPaid + IPmt(rate, i, NPER, PV, FutureValue)
Next i
interests_paid_between = InterestPaid
End Function
Also, I need to include an option where the future value is no equal to 0.
Could you help me with this?
Using Application.InputBox():
Function interests_paid_between(rate As Double, firstPer As Integer, lastPer As Integer, NPER As Integer, PV As Double) As Variant
Dim FutureValue As Double
FutureValue = Application.InputBox("What is the future value of the loan? (if it is 0 put 0 else the value)", Type:=1)
Dim i As Integer
For i = firstPer To lastPer
InterestPaid = InterestPaid + IPmt(rate, i, NPER, PV, FutureValue)
Next i
interests_paid_between = InterestPaid
End Function
In a cell entered:
=interests_paid_between(0.05,1,5,12,-1000)
and inputting 1200 I get:
I don't know if the calculation is correct, but at least it's not zero.
I have a chart embedded on a sheet (X, Y scatter). I also have a mouseover event on the chart which - when you hover over a datapoint - prints the selected value of the corresponding datapoint to a cell. This works with using the .GetChartElement method.
However, I'd also like to add a feature with you can add an arrow (or line) connecting a datapoint and a predefined, named cell. I also managed to do this but unfortunately my calculations aren't accurate enough because the datapoint end of the line is never at the point exactly but somewhere around it (See picture).
The way I did this:
Private Sub myChartClass_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)
Me.myChartClass.GetChartElement X, Y, ElementID, Arg1, Arg2
Set chrt = ActiveSheet.ChartObjects(1).Chart
Set ser = ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
chart_data = ser.Values
chart_label = ser.XValues
YValue = chart_data(Arg2)
XValue = chart_label(Arg2)
'[Code to print corresponding values]
If addComment = True Then Call wks35.addComment(XValue, YValue)
This way I can either pass the coordinates (X, Y variables) and the actual values on the axes (XValue, YValue). Above, the latter is used.
Public Sub addComment( _
ByVal X As Double, _
ByVal Y As Double _
)
Dim chartObj As Chart
Dim chartWidth As Double
Dim chartHeight As Double
Dim l1 As Long, l2 As Long, r1 As Long, r2 As Long
With wks35
Set chartObj = .ChartObjects(1).Chart
chartWidth = chartObj.PlotArea.Width
chartHeight = chartObj.PlotArea.Height
Y = chartHeight - (chartHeight * ((Y - chartObj.Axes(xlValue).MinimumScale) _
/(chartObj.Axes(xlValue).MaximumScale - chartObj.Axes(xlValue).MinimumScale)))
X = chartWidth * ((X - chartObj.Axes(xlCategory).MinimumScale) / _
(chartObj.Axes(xlCategory).MaximumScale - chartObj.Axes(xlCategory).MinimumScale))
l1 = Range("Comment1").Left
l2 = Range("Comment1").Top
r1 = X + ActiveSheet.ChartObjects(1).Left + chartObj.PlotArea.InsideLeft
r2 = Y + ActiveSheet.ChartObjects(1).Top + chartObj.PlotArea.InsideTop
With ActiveSheet.Shapes.AddLine(l1, l2, r1, r2).Line
.ForeColor.RGB = RGB(255, 0, 0)
End With
End With
End Sub
So basically the idea was to have the values on the axes and by calculating its relative position considering the minimum and maximum values on the axis get the datapoint's absolute top and left value from the borders of the plotarea. Then adding the difference of the chart and the plotarea and then the charts top and left.
It may be long and difficult to follow, but I appreciate any help.
Whatever, I figured it out.
I used this
chartWidth = chartObj.PlotArea.InsideWidth
chartHeight = chartObj.PlotArea.InsideHeight
instead of this
chartWidth = chartObj.PlotArea.Width
chartHeight = chartObj.PlotArea.Height
It was almost there so I added some constants to the end (10 to left, 3 to top) the lines are at their place.
I am getting an error at the subroutine called NLRegress. I think the array types are not the same that are being multiplied in the first call in Sub NLRegress. The Z matrix is the following array [1,0.2,0.04: 1,0.5,0.25: 1,0.8,0.64: 1,1.2,1.44: 1,1.7,2.89: 1,2,4]
This is my code :
Option Explicit
Option Base 1
Sub Main()
Dim x() As Double, y() As Double, n As Integer, p As Integer, _
a() As Double, syx As Double, r2 As Double, m As Integer, _
yf() As Double, Z() As Double
Dim i As Integer, k As Integer
For k = 1 To 100
If Worksheets("Sheet1").Range("A2").Cells(k, 1).Value <> "" Then
n = n + 1 'counts the number of data points
Else
Exit For
End If
Next k
For k = 1 To 100
If Worksheets("Sheet1").Range("B2").Cells(k, 1).Value <> "" Then
p = p + 1 'counts the number of data points
Else
Exit For
End If
Next k
If p = n Then
p = n
ReDim yf(n)
Else: MsgBox ("Unequal number of x and y values")
End If
ReDim x(n)
ReDim y(n)
For i = 1 To n 'Read data for matrix x
x(i) = _
Worksheets("Sheet1").Range("A2").Cells(i, 1).Value
Next
For i = 1 To n 'Read data for matrix y
y(i) = _
Worksheets("Sheet1").Range("B2").Cells(i, 1).Value
Next
m = Worksheets("Sheet1").Range("E2").Value
ReDim a(m + 1)
Call BuildZP(x, Z, n, m)
Call NLRegress(Z, y, a, n, m)
Call MultiplyMatrixByVector(Z, a, yf)
End Sub
Sub Fitted_Data(yf, a, x, n)
Dim q As Integer
For q = 1 To n
yf(q) = a(1) + a(2) * x(q) + a(3) * x(q) ^ 2
Worksheets("Sheet1").Range("C2").Cells(q, 1).Value = yf(q)
Next
End Sub
Sub NLRegress(Z, y, a, n, m)
Dim er As Double, tol As Double, ZT() As Double, ZTZ() As Double, ZTZI() As Double, ZTY() As Double
er = 0
tol = 0.0001
ReDim ZT(m + 1, n)
Call TransposeMatrix(Z, ZT)
Call MultiplyMatrices(ZT, Z, ZTZ)
Call MatrixInverse(ZTZ, ZTZI, m + 1, tol, er)
Call MultiplyMatrixByVector(ZT, y, ZTY)
Call MultiplyMatrixByVector(ZTZI, ZTY, a)
End Sub
Sub BuildZP(x, Z, n, m)
Dim i As Integer, j As Integer
ReDim Z(n, m + 1)
For i = 1 To n
For j = 1 To m + 1
Z(i, j) = x(i) ^ (j - 1)
Next j
Next i
End Sub
This answer will probably not solve your issue (see my comment) - but let me nonetheless give you a few best practices that might make programming in VBA easier and maybe prevent such errors in the first place - in your next project.
Try to incorporate the following into your programming
Proper indenting: Every time you use a programming structure the encloses another block of code - such as For, If, While, indent the enclosed code block one level further. E.g. your first few lines of code should look like
For k = 1 To 100
If Worksheets("Sheet1").Range("A2").Cells(k, 1).Value <> "" Then
n = n + 1 'counts the number of data points
Else
Exit For
End If
Next k
You are already using Option Explicit, which is great. However, you should also properly Dim each variable in the procedure/function calls - e.g. Sub Fitted_Data(yf as Double, ...)
You're using a total of 12 variables in your main procedure. This is a very strong indicator, that your routine is doing too much! Better break it up in to small sub routines and maybe use a few module wide variables - see the example below.
The variable names are absolutely meaningless - which makes it hard to debug for you - and almost impossible for outsiders to understand what your code is doing.
AFAIK your first 25 rows "only" assign two ranges to an array and check if these are the same size. Using the syntax x = StartRange.Resize(NumberOfRows).Cells you can achieve this with much less code - and it executes much faster.
Same thing goes finding the first blank row - instead of looping, use StartRange.End(xlDown) - this will return you the last non-blank row!
Also, if you want to assign an array to a range, it works the other way round, too: StartRange.Resize(NumberOfRows) = x.
Hardcoding Worksheets("Sheet1").Range("A2") will lead to problems when the user changes the worksheet structure, e.g. rename the sheet or insert rows/columns. Better assign the cells A2 and B2 names, e.g. StartVector1 and then access them with Range("StartVector1"). Much more robust - and your code is less cluttered
"Don't repeat yourself" (DRY). If you see yourself doing the same code twice, make it a separate procedure - e.g your code to count the number of data points
No need to use Call Sub(x, y) - Sub x, y is equivalent to it in VBA
Excel function can also be used in VBA. This is especially handy for matrix function. E.g. to transpose an array, you could use this code: transposedX = worksheetFunctions.Transpose(x)
Here's the code structure with the first few
Option Explicit
Private mVec1() As Double 'Better give a better name representing the target content of variable
Private mVec2() As Double 'I use m as a prefix to indicate module wide scoped variables
Public Sub SubDoingSomething() 'Use a name that tells the reader what the sub does
LoadVectors
BuildZP Z, n, m 'use proper variable names here
NLRegress Z, y, a, n, m 'and maybe use some more module wide variables that you don't need to pass
MultiplyMatrixByVector Z, a, yf
End Sub
Private Sub LoadVectors()
Dim count1 As Long, count2 As Long
count1 = GetRowLength(Range("StartVector1"))
count2 = GetRowLength(Range("StartVector2"))
If count1 <> count2 Then
MsgBox ("Unequal number of x and y values")
End
End If
mVec1 = Range("StartVector1").Resize(count1).Cells
mVec2 = Range("StartVector2").Resize(count2).Cells
End Sub
Private Function GetRowLenght(rng As Range)
If rng.Offset(1) = "" Then
GetRowLength = 1
Else
GetRowLength = rng.End(xlDown).Row - rng.Row + 1
End If
End Function
I have written a VBA code that solves a set of algebraic equations of the form
A(i)X(i-1)+B(i)X(i)+C(i)X(i+1)=R(i)
A portion of the function is given below. Currently, the coefficients A, B, C, and R have to be stored in columns in the main worksheet to be passed to the function. Is there a way to provide the flexibility of having the coefficients either in rows or columns?
Function TRIDI(ByVal Ac As Range, ByVal Bc As Range, ByVal Cc As Range, _
ByVal Rc As Range) As Variant
Dim BN As Single
Dim i As Integer
Dim II As Integer
Dim A() As Single, B() As Single, C() As Single, R() As Single, X() As Single
N = Ac.Rows.Count
ReDim A(N), B(N), C(N), R(N), X(N)
For i = 1 To N
A(i) = Ac.Parent.Cells(Ac.Row + i - 1, Ac.Column)
B(i) = Bc.Parent.Cells(Bc.Row + i - 1, Bc.Column)
C(i) = Cc.Parent.Cells(Cc.Row + i - 1, Cc.Column)
R(i) = Rc.Parent.Cells(Rc.Row + i - 1, Rc.Column)
Next i
maybe you can add an optional variable to the function to indicate a column function.
Se example: (Edited)
Function TRIDI(ByVal Ac As Range, ByVal Bc As Range, ByVal Cc As Range, ByVal Rc As Range) As Variant
Dim BN As Single
Dim i As Integer
Dim II As Integer
Dim ColumnN As Boolean
Dim A() As Single, B() As Single, C() As Single, R() As Single, X() As Single
If Ac.Rows.Count = 1 Then
N = Ac.Columns.Count
ColumnN = True
Else If Ac.Columns.Count = 1 Then
N = Ac.Rows.Count
Else
Exit Function
End If
ReDim A(N), B(N), C(N), R(N), X(N)
If ColumnN = True Then
For i = 1 To N
A(i) = Ac.Parent.Cells(Ac.Row, Ac.Column + i - 1)
B(i) = Bc.Parent.Cells(Bc.Row, Bc.Column + i - 1)
C(i) = Cc.Parent.Cells(Cc.Row, Cc.Column + i - 1)
R(i) = Rc.Parent.Cells(Rc.Row, Rc.Column + i - 1)
Next i
Else
For i = 1 To N
A(i) = Ac.Parent.Cells(Ac.Row + i - 1, Ac.Column)
B(i) = Bc.Parent.Cells(Bc.Row + i - 1, Bc.Column)
C(i) = Cc.Parent.Cells(Cc.Row + i - 1, Cc.Column)
R(i) = Rc.Parent.Cells(Rc.Row + i - 1, Rc.Column)
Next i
End If
End Function
I might have missed some of the functionality of your function in the example, but i think you get the point. If this does not work give me feedback and ill try another solution. :)
Edit: You can also make the function above a function that receives input form two other functions named CTRIDI and RTRIDI. These two functions just pas ether true or false to the column variable.