I am working on a code that should calculate simple foundations, and in order to do that I have to return 2 values with my function -preferably in two different columns.
Function FundacaoSimples(b, l, carga) As Variant
tensao = Sheets("Tabelas e Constantes").Range("tensao").Value
Dim area As Double
Dim Bs As Single
Dim Ls As Single
Dim Resultado(1 To 2) As String
If b = l Then
area = (1.1 * carga) / tensao
Bs = Sqr(area)
Ls = Bs
ElseIf b <> l Then
area = (1.1 * carga) / tensao
Bs = Sqr((2 * area) / 3)
Ls = (3 * Bs) / 2
End If
Resultado(1) = Round(Bs, 2)
Resultado(2) = Round(Ls, 2)
FundacaoSimples = (Resultado(1) & " / " & Resultado(2))
End Function
This rounding I am using it just to get a value rounded with 2 decimals, e.g: 2,73 to 2,75; 0,89 to 0,90.
I tried working with ActiveCells.Offset(0,1), but the statement isn't valid.
Is it possible to to just jump one column to the right?
You could use ActiveCell.Offset(0, 1).value = SomeValue, however - That's when writing a regular Sub. You're writing a Function / User Defined Function.
Within a UDF it is not possible to alter different cells.
However, a workaround is to have the UDF and when it's entered in a cell, you can then use the Worksheet_Change event to alter the cell next to the Target parameter of that event.
Edit:
Some sample code:
In a regular module:
Public Function MyUDF(param1 as integer, param2 as integer) as Integer
MyUDF = param1 + param2
End Function
In the Worksheet where you want the offset:
Private Sub Worksheet_Change(Byval Target as Range)
If Left(Target.Formula, 6) = "=MyUDF" Then
Target.Offset(0, 1).value = "somevalue at the offset cells"
End If
End Sub
In general, functions should not be writing values or accessing values from a spreadsheet. They should access their parameters and return result.
Try like this, an oversimplified version of what you need:
Option Explicit
Public Sub TestMe()
ActiveCell = FundacaoSimples(0)
ActiveCell.Offset(0, 1) = FundacaoSimples(1)
End Sub
Function FundacaoSimples() As Variant
ReDim varResult(1)
varResult(0) = 55
varResult(1) = 100
FundacaoSimples = varResult
End Function
Then you can edit the function a bit with your own parameters and use it further.
Related
Can someone please explain why the first (IncomeTax) of these 3 UDFs is able to work perfectly, but the second one (MedicareLevy) comes up with #REF! and the third (MedicareSC) one comes up with #VALUE?
The MedicareLevy one actually worked fine as well until I created the MedicareSC one, but now even when I remove the MedicareSC I can't seem to get it to work again.
I have tried replacing some of the ranges or variables from the IncomeTax function to see if it works, but yea...
Function IncomeTax(income As Double) As Double
Rng = Range("taxrates")
Base = Application.WorksheetFunction.VLookup(income, Rng, 2)
minbrac = Application.WorksheetFunction.VLookup(income, Rng, 1)
taxRate = Application.WorksheetFunction.VLookup(income, Rng, 3)
IncomeTax = Base + (income - minbrac) * taxRate
End Function
Function MedicareLevy(income As Double) As Double
ExemptionLimit = Application.WorksheetFunction.VLookup(income, Range("medicarelevy"), 2)
LevyRate = Application.WorksheetFunction.VLookup(income, Range("medicarelevy"), 3)
MedicareLevy = (income - ExemptionLimit) * LevyRate
End Function
Function MedicareSC(income As Double, insurance As String) As Double
Rng = Range("medicaresurcharge")
SCRate = Application.WorksheetFunction.VLookup(income, Rng, 2)
If insurance = "yes" Then
MedicareSC = 0
ElseIf insurance = "no" Then
MedicareSC = income * SCRate
End If
End Function
this is a simple stock price change code
my code is function(with parameters)
Function VanillaCall(S0 As Single, Exercise As Single, Mean As Single, sigma As Single, _
Interest As Single, Time As Single, Divisions As Integer, Runs As Integer) As Single
deltat = Time / Divisions
interestdelta = Exp(Interest * deltat)
up = Exp(Mean * deltat + sigma * Sqr(deltat))
down = Exp(Mean * deltat - sigma * Sqr(deltat))
pathlength = Int(Time / deltat)
piup = (interestdelta - down) / (up - down)
pidown = 1 - piup
Temp = 0
For Index = 1 To Runs
upcounter = 0
For j = 1 To pathlength
If Rnd > pidown Then upcounter = upcounter + 1
Next j
callvalue = Application.Max(S0 * (up ^ upcounter) * (down ^ (pathlength - upcounter)) - Exercise, 0) / (interestdelta ^ pathlength)
Temp = Temp + callvalue
Next Index
VanillaCall = Temp / Runs
End Function
parameters are passed from cells in excel.
i want to execute this function from button click and display return value in a cell say b12.
i have tried putting the code inside a button sub but its not working ,a call vanillacall inside sub too isnt working.
like..
private sub button1_click()
call vanillacall
end sub
Private Sub button1_click()
Range("B12").Value = vanillacall(....)
End Sub
As per your request, Pass arguments in Range like below. Below code is just for example (due to the changes in excel data)
Sub testing33()
Range("B12") = sample(Range("A5"), Range("B5"))
End Sub
Function sample(a As Range, b As Range)
sample = a.Cells.Value & ", " & b.Cells.Value
End Function
I'd do something like the below which would allow me to pick the range containing the data I want to pass to the function (as long as the range is contiguous and contains 8 cells) and pick the cell I want to output the result to.
Private Sub button1_click()
Dim inRng As Range, outRng As Range
inSelect:
Set inRng = Application.InputBox("Select Range to Calculate", Type:=8)
If inRng.Cells.Count <> 8 Then
MsgBox "Select a range with 8 cells!", vbCritical
GoTo inSelect
End If
outSelect:
Set outRng = Application.InputBox("Select Cell to Output To", Type:=8)
If outRng.Cells.Count > 1 Then
MsgBox "Select only one cell!", vbCritical
GoTo outSelect
End If
outRng.Value = VanillaCall(inRng.Cells(1), inRng.Cells(2), inRng.Cells(3), inRng.Cells(4), inRng.Cells(5), inRng.Cells(6), inRng.Cells(7), inRng.Cells(8))
End Sub
You need to get the values from the sheet and save in variables. Then pass the variables to the function. Then output the result to the sheet somewhere. You will need to adjust the range addresses and worksheet name as appropriate.
Private sub button1_click()
dim ws as worksheet
Set ws = worksheets("Sheet1") ' < change the sheet name as appropriate
dim S0 As Single
dim Exercise As Single
dim Mean As Single
dim sigma As Single
dim Interest As Single
dim Time As Single
dim Divisions As Integer
dim Runs As Integer As Single
S0 = ws.Range("B1") '< specify the cell that has this data
Exercise = ws.Range("B2") '< specify the cell that has this data
Mean = ws.Range("B3") '< specify the cell that has this data
sigma = ws.Range("B4") '< specify the cell that has this data
Interest = ws.Range("B5") '< specify the cell that has this data
Time = ws.Range("B6") '< specify the cell that has this data
Divisions = ws.Range("B7") '< specify the cell that has this data
Runs = ws.Range("B8") '< specify the cell that has this data
dim Result as Single
Result = vanillacall(S0, Exercise , Mean, sigma, Interest, Time, Divisions, Runs)
ws.Range("B10") = Result '<specify the cell where you want the result
end sub
I have an excel formula:
=SplitKey(GetSysCd(INDEX([ReportValue],MATCH("mtr_make_model",[FieldName],0)),INDEX([ListName],MATCH("mtr_make_model",[FieldName],0))), 0)
which is running a few subroutines in VBA, but mainly matching values and inserting those values into a cell. When it finds a value for "mtr_make_model" it runs and matches the values inside a sys codes table. The issue I am having is that it is calculating once and then it removes the formula and now has solely the value... In the event that I go to the mtr_make_model field and change the value, the formula does not recalculate. Has anyone heard of this happening? Is this due to something in the VBA code? How do I make that formula stay put and if certain values change, the formula recalculates?
Thanks in advance.
Here are the two functions:
Public Function GetSysCd(ByVal name As String, sysCdTableName As String) As String
Dim r As Integer
Dim sysCdTable As Range
Dim nameList As Variant
Dim sysCd As String
On Error GoTo GetSysCd_Error
Set sysCdTable = Worksheets("sys_cd").Range(sysCdTableName)
nameList = WorksheetFunction.Index(sysCdTable, 0, 2)
r = WorksheetFunction.Match(name, nameList, 0)
sysCd = WorksheetFunction.Index(sysCdTable, r, 1)
GetOutOfHere:
On Error GoTo 0
GetSysCd = sysCd
Exit Function
GetSysCd_Error:
sysCd = ""
GoTo GetOutOfHere
End Function
Public Function SplitKey(s As String, v As Integer)
Dim aString As Variant
Dim r As Integer
If Len(s) > 2 Then
aString = Split(s, "_")
If v = 0 Or v = 1 Then
SplitKey = aString(v)
Else
SplitKey = aString(0)
End If
Else
SplitKey = ""
End If
End Function
I don't think the functions are relevant at this point, but rather just a matter of the function not recalculating when a variable in the formula changes...
The problem could be that Excel only recalculates functions when one of their arguments changes, and your GetSysCd function is referring to a range that is not in its argument list
Set sysCdTable = Worksheets("sys_cd").Range(sysCdTableName)
where sysCdTableName is just a string rather than a reference.
You can make the functions recalculate in real time by adding Application.Volatile True to the top of each function.
I'm writing a script that will count a numbers of days between few separate dates. I have a data in cell like:
1-In Progress#02-ASSIGNED TO TEAM#22/01/2013 14:54:23,4-On
Hold#02-ASSIGNED TO TEAM#18/01/2013 16:02:03,1-In Progress#02-ASSIGNED
TO TEAM#18/01/2013 16:02:03
That's the info about my transaction status. I want to count the numbers of days that this transaction was in "4-On Hold". So in this example it will be between 18/01/2013 and 22/01/2013.
I wrote something like this(sorry for ma native language words in text)
Sub Aktywnywiersz()
Dim wiersz, i, licz As Integer
Dim tekstwsadowy As String
Dim koniectekstu As String
Dim pozostalytekst As String
Dim dataztekstu As Date
Dim status4jest As Boolean
Dim status4byl As Boolean
Dim datarozpoczecia4 As Date
Dim datazakonczenia4 As Date
Dim dniw4 As Long
wiersz = 2 'I start my scrypt from second row of excel
Do Until IsEmpty(Cells(wiersz, "A")) 'this should work until there is any text in a row
status4jest = False 'is status 4-On Hold is now in a Loop
status4byl = False 'is status 4-On Hold was in las loop
dniw4 = 0 ' numbers od days in 4-On Hold status
tekstwsadowy = Cells(wiersz, "H").Value2 'grabing text
tekstwsadowy = dodanieprzecinka(tekstwsadowy) 'in some examples I had to add a coma at the end of text
For i = 1 To Len(tekstwsadowy)
If Right(Left(tekstwsadowy, i), 1) = "," Then licz = licz + 1 'count the number of comas in text that separates the changes in status
Next
For j = 1 To licz
koniectekstu = funkcjaliczeniadni(tekstwsadowy) 'take last record after coma
Cells(wiersz, "k") = koniectekstu
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
Cells(wiersz, "m") = dataztekstu
status4jest = funkcjaokreslenia4(koniectekstu) 'check if there is 4-On Hold in record
Cells(wiersz, "n") = status4jest
If (status4byl = False And staus4jest = True) Then
datarozpoczecia4 = dataztekstu
status4byl = True
ElseIf (status4byl = True And staus4jest = False) Then
datazakonczenia4 = dataztekstu
status4byl = False 'if elseif funkcion to check information about 4-On Hold
dniw4 = funkcjaobliczeniadniw4(dniw4, datazakonczenia4, datarozpoczecia4) 'count days in 4-On Hold
Else
'Else not needed...
End If
tekstwsadowy = resztatekstu(tekstwsadowy, koniectekstu) 'remove last record from main text
Next
Cells(wiersz, "L") = dniw4 ' show number of days in 4-On Hold status
wiersz = wiersz + 1
Loop
End Sub
Function funkcjaliczeniadni(tekstwsadowy As String)
Dim a, dl As Integer
dl = Len(tekstwsadowy)
a = 0
On Error GoTo errhandler:
Do Until a > dl
a = Application.WorksheetFunction.Find(",", tekstwsadowy, a + 1)
Loop
funkcjaliczeniadni = tekstwsadowy
Exit Function
errhandler:
funkcjaliczeniadni = Right(tekstwsadowy, dl - a)
End Function
Function dodanieprzecinka(tekstwsadowy As String)
If Right(tekstwsadowy, 1) = "," Then
dodanieprzecinka = Left(tekstwsadowy, Len(tekstwsadowy) - 1)
Else
dodanieprzecinka = tekstwsadowy
End If
End Function
Function resztatekstu(tekstwsadowy, koniectekstu As String)
resztatekstu = Left(tekstwsadowy, Len(tekstwsadowy) - Len(koniectekstu))
End Function
Function funkcjadataztekstu(koniectekstu As String)
funkcjadataztekstu = Right(koniectekstu, 19)
funkcjadataztekstu = Left(funkcjadataztekstu, 10)
End Function
Function funkcjaobliczeniadniw4(dniw4 As Long, datazakonczenia4 As Date, datarozpoczecia4 As Date)
Dim liczbadni As Integer
liczbadni = DateDiff(d, datarozpoczecia4, datazakonczenia4)
funkcjaobliczaniadniw4 = dniw4 + liczbadni
End Function
Function funkcjaokreslenia4(koniectekstu As String)
Dim pierwszyznak As String
pierwszyznak = "4"
If pierszyznak Like Left(koniectekstu, 1) Then
funkcjaokreslenia4 = True
Else
funkcjaokreslenia4 = False
End If
End Function
And for now I get
Run-time error "13"
in
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
I would be very grateful for any help.
You are getting that error because of Type Mismatch. dataztekstu is declared as a date and most probably the expression which is being returned by the function funkcjadataztekstu is not a date. You will have to step through it to find what value you are getting in return.
Here is a simple example to replicate that problem
This will give you that error
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "Blah Blah"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
This won't
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "12/12/2014"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
If you change your function to this
Function funkcjadataztekstu(koniectekstu As String)
Dim temp As String
temp = Right(koniectekstu, 19)
temp = Left(temp, 10)
MsgBox temp '<~~ This will tell you if you are getting a valid date in return
funkcjadataztekstu = temp
End Function
Then you can see what that function is returning.
I tried running your code, but it is a little difficult to understand just what it is that you want to do. Part of it is the code in your language, but the code is also hard to read beacuse of the lack of indentation etc. :)
Also, I do not understand how the data in the worksheet looks. I did get it running by guessing, though, and when I did I got the same error you are describing on the second run of the For loop - that was because the koniectekstu string was empty. Not sure if this is your problem, so my solution is a very general.
In order to solve this type of problem:
Use Option Explicit at the top of your code module. This will make you have to declare all variables used in the module, and you will remove many of the problems you have before you run the code. Eg you are declaring a variable status4jest but using a different variable called staus4jest and Excel will not complain unless you use Option Explicit.
Declare return types for your functions.
Format your code so it will be easier to read. Use space before and after statements. Comment everything! You have done some, but make sure a beginner can understand. I will edit you code as an example of indentation.
Debug! Step through your code using F8 and make sure all variables contain what you think they do. You will most likely solve your problem by debugging the code this way.
Ask for help here on specific problems you run into or how to solve specific problems, do not send all the code and ask why it is not working. If you break down your problems into parts and ask separately, you will learn VBA yourself a lot faster.
A specific tip regarding your code: look up the Split function. It can take a string and make an array based on a delimiter - Example: Split(tekstwsadowy, ",") will give you an array of strings, with the text between the commas.
Did I mention Option Explicit? ;)
Anyway, I hope this helps, even if I did not solve the exact error you are getting.
I am trying to put the below formula into a UDF so that I can get a cumulative return when I aggregate monthly returns.
In excel the formula has to be recognized as an array so when I type it in I press Ctrl + Shift + Enter to get the {} brackets around the formula.
Does anyone know how to do this?
I want to be able to just type in returns_calc() and select the range that would fit into the returns variable below.
{=(PRODUCT(1+returns/100)-1)*100}
You can use the [ ] notation in Application.Evaluate to calculate Array Formulas in VBA. Your above formula can be called in VBA in just 1 line as shown below
Sub Sample()
MsgBox Application.Evaluate(["=(PRODUCT(1+returns/100)-1)*100"])
End Sub
Now modifying it to accept a range in a function, you may do this as well
Function returns_calc(rng As Range) As Variant
On Error GoTo Whoa
Dim frmulaStr As String
frmulaStr = "=(PRODUCT(1+(" & rng.Address & ")/100)-1)*100"
returns_calc = Application.Evaluate([frmulaStr])
Exit Function
Whoa:
returns_calc = "Please check formula string" 'or simply returns_calc = ""
End Function
EXAMPLE SCREENSHOT
Something like this
Public Function Range_Product(theRange As Variant)
Dim var As Variant
Dim j As Long
var = theRange.Value2
Range_Product = 1#
For j = LBound(var) To UBound(var)
Range_Product = Range_Product * (1 + var(j, 1) / 100)
Next j
Range_Product = (Range_Product - 1) * 100
End Function