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.
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 a string containing special characters ('★☆☽☾☁') and i would like to have ★ printed out for monday, ☆ for tuesday, ☽ for wednesday, ☾ for thursday, and ☁ for friday. i apologize since i am very new to vb.net so i have only very basic knowledge about it. i have already tried this:
Dim today As Date = Date.Today
Dim dayIndex As Integer = today.DayOfWeek
Dim specialcharacters() As Char = "★☆☽☾☁"
If dayIndex < DayOfWeek.Monday Then
txtRandomCharacter.Text = specialcharacters
End If
i would be extremely grateful if anyone could help, thank you!
How's this?
Const specialcharacters() As Char = "★☆☽☾☁"
Dim today As Date = Date.Today
Dim dayIndex As Integer = today.DayOfWeek
If dayIndex >= DayOfWeek.Monday andalso dayIndex <= DayOfWeek.Friday Then
txtRandomCharacter.Text = specialcharacters(dayIndex - dayOfWeek.Monday)
End If
It works because the value of DayOfWeek.Monday through DayOfWeek.Friday are sequential.
(Re-edit to correct my previous error of using VBA instead of VB.net)
Yes. Noting that you only have 5 Char in your array (specialcharacters()) I assume you only want to mark Monday to Friday. However, the answer to this question can be extended to cover all week. Using your original code as the base:
Dim txtRandomCharacter As Char = ""
Dim specialcharacters() As Char = "★☆☽☾☁"
Dim today As Date = Date.Today
Dim dayIndex As Integer = today.DayOfWeek
If (dayIndex - 1) <= UBound(specialcharacters) Then
txtRandomCharacter = specialcharacters(dayIndex - 1)
End If
However, note the mental gymnastics required in dealing with 0-based arrays.
Dim dayIndex As Integer = Weekday(today,vbMonday) is also valid code.
Explanation for Weekday can be found at http://www.excelfunctions.net/vba-weekday-function.html.
specialcharacters is an array, not a string, so that you can access the array element directly. I have used the UBound function so that you don't accidently get an array out of bounds error by calling a subscript (dayIndex) that is higher than your array is long.
Another option is to use the Mid or Substr function with strings. In this example I have also concatenated some code for brevity.
Dim txtRandomCharacter As String = ""
Const specialcharacters As String = "★☆☽☾☁"
Dim dayIndex As Integer = Date.Today.DayOfWeek ' - DayOfWeek.vbMonday + 1
txtRandomCharacter = If(dayIndex >= 0 And dayIndex <= Len(specialcharacters), specialcharacters.Substring(dayIndex - 1, 1), "X")
The 'X' option in the IIF statement was my addition for testing. You can also use "". Unfortunately, the Substr function in VB.Net is a little less tolerant than the Mid function, hence the additional checks on valid values for dayIndex. And Substr is 0-based.
Using the Mid function, which is tolerant of indexes > length of the string but must be > 0 (hence the If statement):
Dim txtRandomCharacter As String = ""
Const specialcharacters As String = "★☆☽☾☁"
Dim dayIndex As Integer = Date.Today.DayOfWeek ' - DayOfWeek.vbMonday + 1
txtRandomCharacter = Mid(specialcharacters, If(dayIndex > 0, dayIndex, Len(specialcharacters) + 1), 1)
Check your Option Base to see if your arrays start by default at 0 or 1. specialcharacters() could be ranging from 0-4 or 1-5 depending on this setting - which means is may or may not align with the Weekday function which is always in the range 1-7 (or the DayofWeek function which ranges from 0 to 6).
The key point is to understand the difference between a string and an array of characters.
With an array of characters - use array subscripts to select the right member. Check to ensure you are not passing an index that is out of bounds for the array.
With a string, use a Mid or Substr function to get the character from the string. Check to ensure you are not passing an index that is out of bounds.
The other point to recognise is to understand how the days of the week are enumerated. The MSDN reference site only notes the enumeration and does not provide an equivalent integer - the IDE provides some more information. This is important to understand if your counting starts from 0 or 1, and whether you must adjust your index to address this.
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
I have a function that takes optional arguments in pairs: firstRange_1, secondRange_2; firstRange_2, secondRange_2; etc.
For each optional argument I need to execute a series of statements if the argument is passed to the function.
For example
dim firstRange_1 as range
dim secondRange_1 as range
dim firstRange_2 as range
dim secondRange_2 as range
etc.
dim firstCell_1 as string
dim lastCell_1 as string
dim firstCell_2 as string
dim lastCell_2 as string
etc.
If IsMissing(firstRange_1) = False Then
firstCell_1 = secondRange_1.Cells(1,1).Address
lastCell_1 = secondRange_1.Cells(secondRange_1.Rows.Count, secondRange_1.Rows.Count)
End if
if IsMissing(firstRange_2) = False Then
firstCell_2 = secondRange_2.Cells(1,1).Address
lastCell_2 = secondRange_2.Cells(secondRange_2.Rows.Count, secondRange_2.Rows.Count)
End If
Is it possible to "build" (sorry if the terminology isn't correct, I'm not yet experienced in programming or vba) the variables on the fly?
for example a loop like
For n=1 to 100
If IsMissing(firstRange_ & "n") = False Then
firstCell_ & "n" = secondRange_ & "n".Cells(1,1).Address
lastCell_ & "n" = secondRange_ & "n".Cells(secondRange_ & "n".Rows.Count, secondRange_ & "n".Rows.Count)
End If
Next
Edit:
See my comments to Branislav Kollár for updates.
I think what you need to rewrite the function to use ParamArrays (see the "Using an Indefinite Number of Arguments" section). Something like this:
myFunction(ParamArray userRanges()) As Range'or whatever Data Types you need
This way, you could use the LBound and UBound functions to see how many arguments were passed into function, leaving the necessity to check if they are missing.
For example you can create a 2 new arrays inside the function (not the argument array) for determining the first and last cells of each argument range. This is not the only way, you can use 2D arrays or put everything into one array. This is just one way.
Function myFunction(ParamArray userRanges()) As Range
Dim firstCell() As Range
Dim lastCell() As Range
ReDim firstCell(UBound(userRanges))
ReDim lastCell(UBound(userRanges))
For x = 0 To UBound(userRanges)
Set firstCell(x) = userRanges(x).Range("A1")
Set lastCell(x) = firstCell_1(x).Offset(userRanges(x).Rows.Count - 1, userRanges(x).Columns.Count - 1)
Next x
'other code to actually do something with the cells
'...
End Function
Try this, if you have any trouble, please let us know.
One more link to learn about this Understanding the ParamArray
Edit 1
Based on comment from OP, I rewritten the code, so that now each input range userRanges will have firstCell and lastCell stored in appropriate arrays. I didn't realize the limitation of my previous post before.
The only think to keed in mind now, is that the index 0 is first range; 1 is second range; 2 is third range; etc.
Or you can use Option Base 1 to make it more naturally indexed, but that is not recommended for some reason.
You can't dynamically name variables, but you can use Arrays. They are stupid powerful, so it's worth learning about them.
Essentially you will make 2 arrays. One for your input (variable1_n) and one of your outputs (output_1_n).
Dim inputArray(1 to 100) as String 'or whatever type these are supposed to be
Dim outputArray(1 to 100) as Range 'perhaps these are ranges?
For i = 1 to 100
Set outputArray(i) = function(inputArray(i))
Next i
Now you have an array full of ranges!
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.