So I've got quite the specific task. I want to create a function that will add decibel units together. Currently, you have to input something like
=10*LOG10(10^(A1/10)+10^(A2/10))
and make this even longer if you have like 15 parts you want to add together. Kind of a pain.
Ideally, it would work like the excel function SUM and just take in any input. Can someone help me put this together, or at least show me what SUM would look like if you had to create it from scratch?
Best,
T. Heng
This little UDF() will give you more flexibility:
Public Function decibelle(rng As Range, N As Long) As Double
Dim wf As WorksheetFunction, i As Long, Z As Double
Set wf = Application.WorksheetFunction
For i = 1 To N
Z = Z + 10 ^ (rng(i) / 10)
Next i
decibelle = 10 * wf.Log10(Z)
End Function
where the first argument is the range of inputs and the second argument is the number of inputs:
EDIT#1:
and if you want the UDF() to be more like SUM() consider:
Public Function decibelle2(rng As Range) As Double
Dim wf As WorksheetFunction, r As Range, Z As Double
Set wf = Application.WorksheetFunction
For Each r In rng
Z = Z + 10 ^ (r.Value / 10)
Next r
decibelle2 = 10 * wf.Log10(Z)
End Function
so you could use it like:
=decibelle2(A1:A2)
The below is a very simple example of a User Defined Function (which should be typed into a standard module) that can take any number of parameters and return the sum of these parameters. Your example seems to involve more advanced logic, so you will have to expand upon my example. Let us know if you need more assistance.
Function AddSomeDigits(ParamArray nums()) As Double
Dim vRunningTotal As Variant
vRunningTotal = 0
For i = LBound(nums) To UBound(nums)
vRunningTotal = vRunningTotal + nums(i)
Next i
AddSomeDigits = vRunningTotal
End Function
Related
I think I need to do a loop here but I'm not quite sure how exactly to write out the syntax as I'm used to just using the max function.
The function I need to create takes in two arrays; the first array has the numeric values while the second array has strings. The function is supposed to find the value in the first array that is the largest and return the corresponding string from the second array.
I'm not sure exactly how to construct my loop. I'm thinking I need to use some form of conditional statements.
Here's what I have so far:
Function FindMax(valueArray() As Integer, nameArray() As String) As String
Dim i As Long, y As Long
y = valueArray(0) 'change to 1 if using a different array structure
FindMax = nameArray(0) 'change to 1 if using a different array structure
For i = LBound(valueArray, 1) To UBound(valueArray, 1)
If valueArray(i) > y Then
y = valueArray(i)
FindMax = nameArray(i)
End If
Next i
Debug.Print ; y
Debug.Print ; FindMax
End Function
Here's a worksheet formula that gets the job done quick & easy:
=INDEX($C$3:$C$10,MATCH(MAX($B$3:$B$10),$B$3:$B$10))
If your:
Numbers of which to find the Maximum are in cells B3:B10, and,
Strings that you want to return are in cells C3:C10
...then the Maximum can be found with:
{MyMax} =MAX($B$3:$B$10)
...and the "Position #` of {MyMax} can be found with:
{Pos#} =MATCH( {MyMax} ,$B$3:$B$10)
...and the corresponding string can be found with:
=INDEX($C$3:$C$10, {Pos#} )
...so if we put it all together, we get:
=INDEX($C$3:$C$10,MATCH(MAX($B$3:$B$10),$B$3:$B$10))
Function FindMax(valueArray() As Integer, nameArray() As String) As String
dim i as long, y as long
y = valueArray(0) 'change to 1 if using a different array structure
FindMax = nameArray(0) 'change to 1 if using a different array structure
for i = lbound(valueArray,1) to ubound(valueArray,1)
if valueArray(i) > y then
y = valueArray(i)
FindMax = nameArray(i)
end if
next i
End Function
Pay attention to the bottom half of the code. See where is say :
this=FindMax(arr,arr2)
?
That is how you call a function. Obviously you'll need two arrays to pass to this function. I suggest googling "Functions vba" and do some light reading.
I'm new to Excel VBA and its been 5 years since I've done any VBA at all. I've written a UDF to do a basic regression, but I can't get it to output an array of regressed values. I select the range I want to output so and hit crtl+shift+enter, but it doesn't work. I've tried a few different things, but nothing does the trick. Here is my latest attempt:
Function REGRESSMEDIAN(x As Range, y As Range) As Double
Dim slope As Double, intercept As Double, count As Integer
count = x.count
Dim lny() As Double, regression() As Double
ReDim lny(1 To count), regression(1 To count)
Dim i As Integer
For i = 1 To count
lny(i) = Application.WorksheetFunction.Ln(y(i))
Next i
slope = Application.WorksheetFunction.slope(lny, x)
intercept = Application.WorksheetFunction.intercept(lny, x)
Dim j As Integer
For j = 1 To count
regression(j) = Exp(slope * x(j) + intercept)
Next j
REGRESSMEDIAN = regression
End Function
This test function:
Function tester()
tester = Array("a", "b", "c")
End Function
will work fine as a UDF as long as your 3 output cells are in a row, not in a column. If they're in a column then you'll just see "a" in all 3 cells.
If you're trying to put the output in a column then this will work:
Function tester()
tester = Application.Transpose(Array("a", "b", "c"))
End Function
Try
Function REGRESSMEDIAN(x As Range, y As Range) As Double()
only putting the parentheses in the function declaration.
It will work.
This code is just to calculate simple moving average. Opened an excel, created dummy array in C row from 1 to 20. I want to create a function for eg: SMA(C7,3) = which should give average of C5:C7.
Coming back to VBA after long time, not able to figure whats the error in the below code.
Function sma1(rng As Range, N As Integer)
Set rng = rng.Resize(-N + 1, 0)
sma1 = Application.WorksheetFunction.average(rng)
End Function
avoid using a cell name as a function
fixed the RESIZE()
used an internal range variable
Function smal(rng As Range, N As Integer) As Variant
Dim rng2 As Range
Set rng2 = rng.Resize(N, 1)
smal = Application.WorksheetFunction.Average(rng2)
End Function
EDIT#1:
Based on Scott's comment:
Function smal(rng As Range, N As Integer) As Variant
Dim rng2 As Range
Set rng2 = rng.Offset(1 - N, 0).Resize(N, 1)
smal = Application.WorksheetFunction.Average(rng2)
End Function
I assume you want the column along side it to give you're SMA (as shown below?):
If so, the below will do it and drag it autocomplete it to the bottom of you column C array:
Sub SMA3()
Range("D7").FormulaR1C1 = "=AVERAGE(R[-2]C[-1]:RC[-1])" 'This is a relative reference (left one cell and up two cells) - This give your three inputs
Range("D7").AutoFill Destination:=Range("D7:D" & Range("C1048576").End(xlUp).Row) 'Autofills the SMA
End Sub
Just an FYI this can be done with existing formula:
=IF(ROW(C1)<$E$1,"",AVERAGE(INDEX(C:C,ROW(C1)-$E$1+1):C1))
E1 contains the number of rows to include.
My goal is to find the closest point to a certain point. I have a list of coordinates to different points and I want to find the closest to a certain point (Point1) that is not in that list.
With the MIN function I can find the closest distance between Point1 and the closest point from the list.
The problem is that I can't find the coordinates(or at least one coordinate) of that point. For this I think I need to use VBA.
I would use VBA to find one coordinate of the point I'm looking for (the point with the closest distance) in the column of one coordinate (for example x). I've written an easy code that should give me what I want if I add my if condition but it doesn't work. The if condition I will be using in the code would be:
If columnx = (SQRT(Abs((distance) ^ 2 - ((columny - pt1y) ^ 2))) + pt1x) Then
pt2x = columnx
pt2x would be the function name, pt1y-y coordinate of Point1, pt1x - x coordinate of Point1, the rest you should understand.
The code I have written is:
Function K23S(l As Range, s As Range) As Variant
Dim K() As Variant
K = Range("l").Value
Dim M() As Variant
M = Range("s").Value
Dim i As Long
Dim j As Long
For i = LBound(K) To UBound(K)
For j = LBound(M) To UBound(M)
If K(i) = M(j) Then
p = K(i)
End If
Next j
Next i
p = K23S
End Function
It compares two columns (for example A1:A32 and B1:B32) and should give one's value if the values in the same row match (if they start on the same row). At the moment it gives #VALUE! error. I have tried the For Each as well but the result is the same. Values in the cells are in the right format.
What am I doing wrong? Or maybe you can offer a different solution?
I've used this link, maybe it helps to undestand: http://excelmacromastery.com/Blog/index.php/the-complete-guide-to-using-arrays-in-excel-vba/
*The Excel formulas found on the internet are not giving the right answers in some cases so I would like to try a different approach.
p = K23S should be K23S = p.
Add Option Explicit to the top of your module, too, as it should identify compile errors like this.
Also, you are incorrectly doing your range assignments.
Function K23S(l As Range, s As Range) As Variant
Dim K() As Variant
Dim M() As Variant
K = l.Value
M = s.Value
Dim i As Long
Dim j As Long
For i = LBound(K) To UBound(K)
For j = LBound(M) To UBound(M)
If K(i) = M(j) Then
K23S = K(i)
Exit Function
End If
Next j
Next i
K23S = "Default Value"
End Function
I also added a early exit on your function when it finds the match and a default return value (in case it doesn't find anything).
I just solved my problem. The column nr was supposed to be aaded to the arrays. The correct code would be:
Function K23S(l As Range, s As Range) As Variant
Dim K() As Variant
Dim M() As Variant
K = l.Value
M = s.Value
Dim i As Long
Dim j As Long
For i = LBound(K) To UBound(K)
For j = LBound(M) To UBound(M)
If K(i, 1) = M(j, 1) Then
K23S = K(i, 1)
Exit Function
End If
Next j
Next i
K23S = "Default Value"
End Function
I am trying to check whether a given number is cuberoot or not in VBA.
The following code works only for 2 and 3 as answers, it does not work after that.
I am trying to figure out what is wrong in the code.
Sub cuberoot()
Dim n As Long, p As Long, x As Long, y As Long
x = InputBox("x= ")
If Iscube(x) Then
MsgBox ("Is cube")
Else
MsgBox ("No cube")
End If
End Sub
Private Function Iscube(a As Long) As Boolean
b = a ^ (1 / 3)
If b = Int(b) Then
Iscube = True
Else
Iscube = False
End If
End Function
Since you are passing in a Long I'll assume that you won't have a number bigger than roughly 2*10^9 so this should always work. It's a slight variation where you truncate the double and then compare to the two nearest integers to make sure you catch any rounding errors.
Edit: In VBA the truncating would always round so it's only neccessary to check the 3rd root value:
Public Function Iscube(a As Long) As Boolean
Dim b As Integer
b = CInt(a ^ (1# / 3#))
If (b ^ 3 = a) Then
Iscube = True
Else
Iscube = False
End If
End Function
If you need a number larger than a Long you'll need to change your input type and you might want to consider an iterative method like a binary search or a Newton-Raphson solver instead.
Existing Code
Your code will work if you add a
dim b as long
If you debug your code you will see that feeding in 125 gives you
b = 5
Int(b) = 4
Updated Code
You can shorten your boolean test to this
Function Iscube(lngIn As Long) As Boolean
Iscube = (Val(lngIn ^ (1 / 3)) = Int(Val(lngIn ^ (1 / 3))))
End Function
Note that if you call it with a double, it will opearte on the long portion only (so it would see IsCube(64.01)as IsCube(64))