I'm designing a function in VBA of the form myFunction(x,y,z) where z is a table, and x can take the values of the column headings. As part of the function I need to find the number of rows in z.
I'm having problems with this, as everywhere I look suggests using length = z.Rows.Count, but when I try and output this value (as in, set myFunction = length), it produces a VALUE error. However, when I output myFunction = a which doesn't directly use length (it will eventually form part of an IF statement once I get it working), the function works fine. My code is below:
Public Function myFunction(x As String, y As Double, z As Range) As Double
Dim upper_threshold As Double
Dim lower_threshold As Double
Dim a As Double
Dim rates As Variant
Dim u As Byte
Dim l As Byte
Dim r As Byte
Dim length As Byte
a = 0
u = 2
l = 1
rates = Application.WorksheetFunction.Index(z, 1, 0)
r = Application.WorksheetFunction.Match(x, rates, 0)
length = z.rows.Count
upper_threshold = z(u, 1)
Do While y > upper_threshold
u = u + 1
l = l + 1
upper_threshold = z(u, 1)
lower_threshold = z(l, 1)
If y < upper_threshold Then
a = a + z(l, r) * (y - lower_threshold)
Else
a = a + z(l, r) * (upper_threshold - lower_threshold)
End If
Loop
myFunction = a
End Function
To test it out I also created another function:
Public Function myRows(myTable As Range) As Double
myRows = myTable.rows.Count
End Function
This one works fine on its own, but when I try to use it within the other function, I still get a VALUE error. I've tried declaring length as every type I can think of and it doesn't seem to help.
Can anyone see what's going on?
EDIT: I'm obviously not making myself very clear. The function without the two lines referring to length works as I intended. However, I need to add a bit of code to increase its functionality and this involves calculating the number of rows in the table z. When I add the two lines shown here into the function it continues to work, since it doesn't affect the output. However, if I then set the output to show length, i.e. change the penultimate line to myFunction = length it gives me a VALUE error. This leaves me with two options as far as I can see: either something else in the program is impacting on these two lines (some clashes of syntax or something), or I'm making a mistake in just assuming I can output length like that.
Your problem is with:
rates = Application.WorksheetFunction.Index(z, 1, 0)
Index only accepts a single row or column, otherwise you get a VALUE error.
Related
I created a simple function in MATLAB, and am trying to convert the function into Excel VBA function. My goal is to create an Excel formula =RT('range of dB levels', 'delta-time') and output the estimated reverberation time. The math is simple, see MATLAB code below:
function rr=RT(lvl_broad, dt)
n=12; %number of samples within slope calc
slope=zeros(length(lvl_broad), 1);
for i=1:length(lvl_broad)
if i<((n/2)+1) | i>length(lvl_broad)-(n/2)-1
slope(i)=0;
else
slope(i)=(lvl_broad(i+(n/2))-lvl_broad(i-(n/2)))/n;
end
end
min_slope=min(slope);
rr=abs(dt./min_slope)*60;
end
In excel, I modified/simplified this until I no longer got errors, however, the cell that I enter my 'RT' function in returns #VALUE and I do not know why. Does anything stand out in the code below? (note I changed the input range from lvl_broad to InterruptedNZ)
Function RT(InterruptedNZ, dt)
Dim Slope As Double
Slope = Slope(InterruptedNZ.Height, 1)
For i = 1 To InterruptedNZ.Height
If i < ((6) + 1) Or i > (InterruptedNZ.Height - (6) - 1) Then
Slope(i) = 0
Else
Slope(i) = (InterruptedNZ(i + (6)) - InterruptedNZ(i - (6))) / 12
End If
Next
End
min_slope = Application.WorksheetFunction.Min(Slope)
RT = Abs((dt / min_slope) * 60)
End Function
Here are some tips to translate MATLAB code into VBA code:
length()
If you are trying to get the dimensions of a range, you'll need to use the .Rows.Count or .Columns.Count properties on the range you are working with.
PERFORMANCE NOTE:
When you have a large enough range, it's a good idea to store the values of the range inside an array since you will reduce the number of times you access data from the sheets which can comme with lot of overhead. If so, you'll have to use ubound() and lbound().
zeros()
In VBA, there is no exact equivalent to the zeros() function in MATLAB. The way we would initialize an array of zeros would simply be by initializing an array of doubles (or another numerical type). And since the default value of a double is zero, we don't need to do anything else :
Dim Slope() As Double
ReDim Slope(1 To InterruptedNZ.Rows.Count)
Note that you cannot pass the dimensions in the Dim statement since it only accepts constants as arguments, so we need to create Slope as a dynamic array of doubles and then redimension it to the desired size.
Putting these two principles together, it seems like your code would look something like this:
Function RT(ByRef InterruptedNZ As Range, ByVal dt As Double)
Dim Slope() As Double
ReDim Slope(1 To InterruptedNZ.Rows.Count)
Dim i As Long
For i = 1 To InterruptedNZ.Rows.Count
If i < ((6) + 1) Or i > (InterruptedNZ.Rows.Count - (6) - 1) Then
Slope(i) = 0
Else
Slope(i) = (InterruptedNZ(i + (6)) - InterruptedNZ(i - (6))) / 12
End If
Next
Dim min_slope As Double
min_slope = Application.WorksheetFunction.Min(Slope)
RT = Abs((dt / min_slope) * 60)
End Function
Addtionnal notes:
Refering to cells from a range like this InterruptedNZ(i) works but it is good practice to be more specific like this (assuming column range) :
InterruptedNZ.Cells(i,1)
During my tests, I had a division by zero error since min_slope was zero. You might want to account for that in your code.
I have an issue where I am trying to compare a values that can be alphanumeric, only numeric, or only alphabetic.
The code originally worked fine for comparing anything within the same 100s group (IE 1-99 with alphabetic components). However when I included 100+ into it, it malfunctioned.
The current part of the code reads:
For j = 1 To thislength
If lennew < j Then
enteredval = Left("100A", lennew)
ElseIf lennew >= j Then
enteredval = Left("100A", j)
End If
If lenold < j Then
cellval = Left("67", lenold)
ElseIf lenold >= j Then
cellval = Left("67", j)
End If
'issue occurs here
If enteredval >= cellval Then
newrow = newrow+1
End If
Next j
The issue occurs in the last if statement.
When cycling through the 100 is greater than the 67 but still skips over. I tried to declare them both as strings (above this part of code) to see if that would help but it didn't.
What I am trying to accomplish is to sort through a bunch of rows and find where it should go. IE the 100A should go between 100 and 100B.
Sorry lennew=len("100A") and lennold=len("67"). And thislength=4or whatever is larger of the two lengths.
The problem is that you're trying to solve the comparison problem by attacking specific values, and that's going to be a problem to maintain. I'd make the problem more generic by creating a function that supplies takes two values returns -1 if the first operand is "before" the second, 0 if they are the same, and 1 if the first operand is "after" the second per your rules.
You could then restructure your code to eliminate the specific hardcoded prefix testing and then just call the comparison function directly, eg (and this is COMPLETELY untested, off-the-cuff, and my VBA is VERRRRRY stale :) but the idea is there: (it also assumes the existence of a simple string function called StripPrefix that just takes a string and strips off any leading digits, which I suspect you can spin up fairly readily yourself)
Function CompareCell(Cell1 as String, Cell2 as String) as Integer
Dim result as integer
Dim suffix1 as string
Dim suffix2 as string
if val(cell1)< val(cell2) Then
result = -1
else if val(cell1)>val(cell2) then
result = 1
else if val(cell1)=val(cell2) then
if len(cell1)=len(cell2) then
result =0
else
' write code to strip leading numeric prefixes
' You must supply StripPrefix, but it's pretty simple
' I just omitted it here for clarity
suffix1=StripPrefix(cell1) ' eg returns "ABC" for "1000ABC"
suffix2=StripPrefix(cell2)
if suffix1 < suffix2 then
result = -1
else if suffix1 > suffix2 then
result = 1
else
result = 0
end if
end if
return result
end function
A function like this then allows you to take any two cell references and compare them directly to make whatever decision you need:
if CompareCell(enteredval,newval)>=0 then
newrow=newrow+1
end if
Below is the code i have put together from various examples to try achieve my goal. Concept is to be dynamic and retrieve from survey sheet within my workbook, to be able to obtain the corresponding TVD for the MD
--Use while loop only to run code if there is a depth in Column B Present. Nested loop uses the difference between depths to calculate a gradient.
---The issue i'm having is getting past my first debug error "Invalid Qualifier".
----Lastly, any suggestions for how i would then return the TVD to Column A, relevant to the looked up MD, within the nested loop to maintain the row in which the MD was grabbed. Sorry for making this so wordy, been working on this for over 10hrs while at work.
http://www.wellog.com/tvd.htm
Sub MdtoTVD()
Dim MD1 As String, MD2 As Integer
Dim TVD1 As String, TVD2 As Integer
Dim Srng As Range 'Survey MD column
Dim MDrng As Range 'MdtoTVD MD column as range
Dim MDdiff As Integer ' Var to calculate difference of MD end from MD start
Dim TVDdiff As Integer ' Var to calculate difference of TVD end from TVD start
Dim TVDincr As Double ' var to use for stepping TVD
Dim MDrow As Integer
Dim i As Long
MDrng = Range("Surveys!B27:B215") 'range from the survey sheet within my report book
Srng = Range("Surveys!G27:G215") 'range from the survey sheet within my report book
Dim X As Integer
X = 2
While Not (IsEmpty(Sheets("MDtoTVD").Cells(X, 2).Value)) 'runs loop as long as there a MD depth to be looked up
Cells(X, 2) = MDrow 'assigns current row value to for MD input
MD1.Value = Application.WorksheetFunction.Index(Srng, Application.WorksheetFunction.Match(MDrow, MDrng, 1)) ' retrieves Start point for MD
MD2.Value = Application.WorksheetFunction.Index(Srng, Application.WorksheetFunction.Match(MDrow, MDrng, 1) + 1) 'retrieves end point for MD
TVD1.Value = Application.WorksheetFunction.Index(MDrng, Application.WorksheetFunction.Match(MDrow, Srng, 1)) 'retrieves start point for TVD
TVD2.Value = Application.WorksheetFunction.Index(MDrng, Application.WorksheetFunction.Match(MDrow, Srng, 1) + 1) 'retrieves end point for TVD
MDdiff.Value = (MD2 - MD1) 'assigns and calculates difference of MD end from MD start
TVDdiff.Value = (TVD2 - TD1) 'assigns and calculates difference of TVD end from TVD start
TVDincr.Value = MDdiff / TVDdiff 'Divides MD by TVD to get increment per foot
For i = 1 To MDdiff Step TVDincr 'set max loop run to amount of feet between survey points
Cells(X, 1).Value = TVD1 + i 'uses the loop to increment the TVD from start point
Next i
Wend
End Sub
I can see a number of problems with your code:
MD1, MD2, TVD1, TVD2 are all of type String. Also, MDdiff, TVDdiff and TVDIncr are all of type Integer. The property Value is not defined for a string or integer variable. Just remove the .Value from all of them and you won't get the "Invalid Qualifier" error.
After you do the above, the following lines will give another error about type mismatch:
MDdiff = (MD2 - MD1)
TVDdiff = (TVD2 - TD1)
because you're trying to subtract a string from another string and assign the result to an integer. Not sure what to advise there, you have to consider what you're trying to achieve and act accordingly. Maybe they shouldn't be strings in the first place? I don't know, up to you to determine that.
At the very least, you can cast strings to integers if you're really sure they're string representations of integers by doing CInt(string_var) or use CLng to convert to long. If the strings are not string representations of integers and you try to cast them to integers, you'll get a type mismatch error.
When you assign a value to a Range object, you need to use Set. So do:
Set MDrng = Range("Surveys!B27:B215")
Set Srng = Range("Surveys!G27:G215")
to correctly set the ranges.
Another problem is that you haven't assign a value to X but you use it as a cell index. By default, uninitialised numeric variables in VBA get assigned the value of 0, so doing .Cells(X, 2) will fail because row 0 is not a valid row index.
In this line:
TVDincr = MDdiff / TVDdiff
you're dividing two integers and you assign the result to another integer. Note that if the result of the division happens to be a decimal (like 3 / 2 = 1.5), your TVDincr integer will actually contain just 1, i.e. you lose some precision. I don't understand your code to know if it's ok or not, you have to judge for yourself, I'm pointing it out just in case you're not aware of that.
Also, if TVDdiff happens to be 0, then you'll get a "division by zero" error.
This line in your For loop:
Cells(X, 1).Value = TVD1 + i
will also generate an error, because you're trying to numerically add TVD1 (a string) and i (a long). Perhaps you're trying to concatenate the two, in which case you should replace + with &.
There's also a problem when calling the WorksheetFunctions, but I haven't been able to determine the cause. Probably if you fix the other errors then it'll be easier to understand what's going on, not sure though. You just have to investigate things a little bit too.
I want the function to take a range of cells as an argument and return their product.
Let's assume the following value for cells:
A1=5
A2=2
A3=3
Let's call the function Multiply.
=Multiply(A1:A3) will return 30 (=5×2×3).
What is the code for this? I'm just trying to familiarize myself with the syntax and this will help out a lot.
Edit: figured it out:
Function multiply(rng As Range)
multiplied = 1
For Each cell In rng
multiplied = multiplied * cell.Value
Next
multiply = multiplied
End Function
You can use the VBA version of PRODUCT directly, ie
MsgBox WorksheetFunction.Product([a1:a3])
You can use excel worksheet functions.
The default behaviour of SUMPRODUCT if there is only a single range provided is to return the sum so you can just pass the range to SUMPRODUCT this way:
WorksheetFunction.Sumproduct(**your range goes here**)
OK for =PRODUCT, which does the job (SUMPRODUCT will NOT do what the initial fellow asked).
But, just for fun, using the properties of the math functions EXP and LN we have that if
X = A1*B1*C1 then
LN(X) = LN(A1)+LN(B1)+LN(C1)
and
X = EXP(LN(X)) or
X = EXP(LN(A1)+LN(B1)+LN(C1))
so just put in a cel: =EXP(SUM(LN(A1:C1))) and voilà! (you must use CTRL+SHIFT+ENTER)
If you insist of writing your own function then try the following. It loads all the values into memory first and thus should work faster.
Public Function RngProduct(ByRef r as Range) as Double
Dim vals() as Variant, res as Double
vals = r.Value
Dim i as Long, N as Long
N = r.Rows.Count
res = #1
For i=1 to N
res = res * vals(i,1)
Next i
RngProduct = res
End Function
So I'm calculating basic statistics in my worksheet and it includes code such as:
xxx = Application.worksheetfunction.average(etc etc etc
yyy = Application.worksheetfunction.min(etc etc etc
zzz = Application.worksheetfunction.max(etc etc etc
My question: Is there an RMS equivalent function where I can simply plug it in place of where I have 'average, min, max' functions in that code? And if there isn't then what would be the most efficient means to code in to find RMS solutions?
I hope I've stated the goal clearly enough. I'm curious as to whether or not there is a predefined RMS function for VBA or whether or not I've got to create some sort of user defined function? ~ That of which I'm fairly new to as well so if there isn't a simple line of code to write for this, I'll have to do more reading on UDF's.
EDIT:
I've got around 30,000 rows, and for simplicity's sake: imagine two columns. Column A has the year i.e. 1941 or anything else through 2008. Column B is a numeric value. I'm just trying to put code together that gives decade summaries of Average, Min, Max, and the RMS values.
You can do the average with
=SQRT(SUMSQ(A:A)/COUNTA(range))
or in VBA:
r = (Application.WorksheetFunction.SumSq(Range("A:A")) / Range("A:A").Count) ^ (1 / 2)
A VBA function that accepts arrays (any rank) and ranges with multiple areas (a discontinuous range like A4:B6,C11:D15), or even a union of ranges in a formula. It skips non number datatypes (including dates, boolean, blanks etc).
You can use it in VBA code, or as a UDF in a worksheet formula such as:
"=RMS(A1:A10)" (basic usage)
"=RMS(A1:A10,C1:C10)" (multiple ranges (or arrays for that matter))
"{=RMS({1,2,3,4})}" (array formula entered with Ctrl+shift+enter)
Function RMS(ParamArray args()) As Double
Dim arg, arr, area As Range, ss As Double, n As Long
For Each arg In args
If TypeOf arg Is Range Then
For Each area In arg.Areas
arr = area.value
If VarType(arr) < vbArray Then
queryRmsElements Array(arr), ss, n
Else
queryRmsElements arr, ss, n
End If
Next area
ElseIf VarType(arg) > vbArray Then
queryRmsElements arg, ss, n
Else
Err.Raise 1, "RMS", "Invalid Argument"
End If
Next arg
RMS = (ss / n) ^ 0.5
End Function
Private Sub queryRmsElements(ByRef elements, ByRef ss As Double, ByRef n As Long)
Static element As Variant
'Enumerate to cover rank > 1 (vs. Iterate)
For Each element In elements
Select Case VarType(element)
Case VbVarType.vbByte, _
VbVarType.vbCurrency, _
VbVarType.vbDecimal, _
VbVarType.vbDouble, _
VbVarType.vbInteger, _
VbVarType.vbLong, _
VbVarType.vbSingle
ss = element ^ 2 + ss
n = n + 1
Case Else
End Select
Next element
End Sub
This one worked for me:
Function RMS(Intervalo As Range)
Dim SomaQ As Double
Dim Tamanho As Integer
SomaQ = 0
Tamanho = Intervalo.Count
SomaQ = Application.WorksheetFunction.SumSq(Intervalo)
RMS = Sqr(SomaQ / Tamanho)
End Function