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!
Related
I'm using a modified match function since years which worked fine. But suddenly I get runtime error 13 for no reason. This function is called two times in the actual process before the error pops up. The first time everything works fine, the second time I get the error. Here's the code:
Public Function xMatch(ByRef Direction_Range As Range, ByVal Find_Value_Or_String, Occ_Number As Integer, Row_True_Or_Column_False As Boolean, RelativePosition_True_Or_AbsolutePosition_False As Boolean) As Integer
Dim xMTcell
toolVar1 = 0
xMatch = 0
occurrencesCount = 0
If RelativePosition_True_Or_AbsolutePosition_False = True Then
If Row_True_Or_Column_False = True Then
toolVar1 = Range(Split(Direction_Range.Address, ":")(0)).Row - 1
Else
toolVar1 = Range(Split(Direction_Range.Address, ":")(0)).Column - 1
End If
End If
For Each xMTcell In Direction_Range
If xMTcell.Value = Find_Value_Or_String Then
occurrencesCount = occurrencesCount + 1
If occurrencesCount = Occ_Number Then
If Row_True_Or_Column_False = True Then
xMatch = xMTcell.Row - toolVar1
Else
xMatch = xMTcell.Column - toolVar1
End If
Exit For
End If
End If
Next xMTcell
End Function
toolVar1 and occurrencesCount are declared in the module. The function can search in any ranges (Direction_Range) and find the Value (Find_Value_Or_String). In contrary to a regular match function you can decide (Occ_Number) which find will be the one you need if there are multiple ones in that range. Also, you can decide if you want the row or the column of that find and if you want that row/column absolute (position compared to worksheet) or relative (position compared to Direction_Range).
The error occurs in this line:
If xMTcell.Value = Find_Value_Or_String Then
Since xMTcell is part of Direction_Range I checked the Range and it is clearly the right one plus it IS a range and nothing else. I also checked the Value and it is a String he is looking for which can be found manually in that range. I can't understand why it works fine in other stages of the process with the exact same type of Direction_Range and Find_Value_Or_String and suddenly it doesn't. I already tried declaring xMTcell as Range but it made no difference.
Anyone an idea?
Regards
Carl
According to the comments i did following checks:
Debug.Print VarType(Direction_Range)
Debug.Print Direction_Range.Address
Debug.Print VarType(xMTcell.Value)
Debug.Print VarType(Find_Value_Or_String)
Debug.Print xMTcell.Address
and for the non-bugging process i get
8204
$A$4:$N$4
8
8
$B$4
and for the bugging process
8204
$A$5:$A$16
8204
8
$A$5:$A$16
so its a problem with the range, why does it behave differently?
TL;DR:
Change For Each xMTcell In Direction_Range to For Each xMTcell In Direction_Range.Cells.
Some debugging and general tips (summarizing the comments and your feedback in them):
Dim xMTcell - make that a Range.
Use Debug.Print (Control+G to bring up the Immediate Window and inspect the output).
Debug.Print VarType(xMTcell.Value) returns 8204: Per the VarType docs, that means that xMTcell.Value is a vbArray of vbVariants (8192 + 12 = 8204).
Debug.Print VarType(Find_Value_or_String) returns 8: Again per the VarType docs, this means Find_Value_or_String is a String.
The type mismatch is because you can't compare a String to an array.
The fact that xMTCell.Value is an array points to xMTCell being a multi-cell range, not a single cell.
... which is verified by the output of Debug.Print xMTcell.Address being a multi-cell range.
Most likely the issue is that you passed a Row or Column as your Direction_Range, i.e. you used Rows or Columns to return a range. When looping over a Row or Column, you need to specify that you're looping over the individual cells.
I've been trying to instantiate an empty array, where I'll be adding elements. For some reason, my script is throwing an error on simply calling Ubound on the empty array. I can't figure out how to instantiate an empty array... Here's what I've got:
Dim data_dates
data_dates = Array("6/24/2019", "7/1/2019", "7/8/2019", "7/15/2019", "7/22/2019", "7/29/2019", "8/5/2019", "8/12/2019", "8/19/2019", "8/26/2019", "9/2/2019")
Dim site_dates
For date_iter = 1 To UBound(data_dates)
If start_date <= data_dates(date_iter) And last_date <= data_dates(date_iter) Then
MsgBox UBound(site_dates) '- LBound(site_dates) + 1
site_dates(UBound(site_dates) + 1) = data_dates(date_iter)
End If
Next date_iter
So that MsgBox line is throwing an error. Is it normal for Ubound to throw an error on an empty array? If so, how do I add the first element to an empty array?
Dim site_dates
This variable is an implicit Variant. While a Variant can very well hold an array, it initializes to Variant/Empty, which isn't an array - that's why UBound(site_dates) is throwing an error: you're trying to get the upper bound of a Variant/Empty, and VBA doesn't know what to do with that.
This declares a dynamic array of Variant items:
Dim site_dates()
That said, in general you should avoid resizing arrays (a loop with ReDim Preserve theArray(UBound(theArray) + 1) is copying the entire array at every iteration just to add a single item - the penalty gets more apparent with more items): if you don't know how many elements you're going to need, it's usually a better idea to use a Collection and Add items as you go. If you do know how many elements you're going to need, then explicitly size the array accordingly, at the declaration site:
Dim site_dates(1 To 10)
Note that Dim statements aren't executable, so you can't use a variable. Use the ReDim statement to do this:
ReDim site_dates(1 To datesCount)
ReDim acts as a declarative statement, so you don't need a prior Dim, even with Option Explicit specified.
In this case you can use Application.WorksheetFunction.CountIf to get the number of dates matching the criteria and size the array before you start iterating the values.
One way to start the growth process:
Sub InTheBeginning()
Dim site_dates() As Date, msg As String
ReDim site_dates(1)
For i = 1 To 10
ReDim site_dates(1 To UBound(site_dates) + 1)
Next i
msg = LBound(site_dates) & vbCrLf & UBound(site_dates)
MsgBox msg
End Sub
First to check that you are using Option base 1 because start your loops with 1??
If you have a setup where you know the max possible site_dates from your data_dates, you can ReDim the site_dates at the beginning (before the loop)to have the same bounds as data-dates.
Keep a track of the number of qualifying items written in a counter in the 'If logic' loop.
Then at the end, you can Redim Preserve down to the amount generated:
ReDim Preserve site_dates(1 to qualifyingCounter)
Alternatively, with no worry about performance you can consider the easiest for me:
Reference mscorlib and use an ArrayList
Dim data_dates
data_dates = Array("6/24/2019", "7/1/2019", "7/8/2019", "7/15/2019", "7/22/2019", "7/29/2019", "8/5/2019", "8/12/2019", "8/19/2019", "8/26/2019", "9/2/2019")
Dim siteDate_ArrayList As New ArrayList
Dim date_iter As Long
For date_iter = 0 To UBound(data_dates)
If date_iter Mod 2 = 0 Then 'I changed this logic just for my test
siteDate_ArrayList.Add data_dates(date_iter)
End If
Next date_iter
Dim site_dates As Variant
'Please note that array resultant from ToArray on an empty ArrayList will have a Ubound of -1
site_dates = siteDate_ArrayList.ToArray
EDIT:
To refernce, go to Tools --> References and look down alphabetically for mscorlib.dll. Then check it.
I have a number of files, with varying sizes. But I want to accomplish the same thing with all of them, load them into a string(,).
Over the last many hours, I've searched for many variations of code similar to this with some small changes it seems, but even then I could only get a single row to load in at best:
Dim strimport As String() = {}
Dim strimportsplit As String(,) = {}
Dim i As Integer = 0
strimport = File.ReadAllLines("C:\test.txt")
For i = 0 To strimport.Length - 1
strimportsplit = strimport(i).Split(New Char() {vbTab}) 'This line doesn't work
Next
This is an example of my files (only they're significantly larger):
aaa fff 0
bbb ggg 1
ccc hhh 2
ddd iii 3
eee jjj 4
This is basically how i'd want the above to load into my array from external text files:
Dim strexample As String(,) = {{"aaa", "fff", "0"},
{"bbb", "ggg", "1"},
{"ccc", "hhh", "2"},
{"ddd", "iii", "3"},
{"eee", "jjj", "4"}}
I've even tried adding all of my tables as string(,)'s to VB manually. That works... But putting it in manually like that jumps up the filesize to ~30mb and gives me a MASSIVE performance hit. Not very ideal.
My question is, how can I load from a text file into a string(,) similar to my last example above?
Thank you very much in advance.
This would be easier if you switched to a Jagged Array rather than a two-dimensional one. The issue (here) with two-dimensional arrays is that you can only access and modify one element at a time, whereas with a jagged array you can access an entire row.
A jagged array is essentially an array of arrays, and can be declared like:
Dim strimportsplit As String()()
You'd have to set its row size to that of strimport.Length to ensure that it can hold the same amount of lines:
Dim strimport As String()
Dim strimportsplit As String()()
'Dim i As Integer = 0 -- No need for this, it's declared by the loop.
strimport = File.ReadAllLines("C:\test.txt")
strimportsplit = New String(strimport.Length - 1)() {}
NOTE: The reason I use strimport.Length - 1 above is because in VB.NET you actually don't specify the length when declaring a new array, but rather the index of the last item. And since indexes start at 0 the last item will have index Length - 1.
Then inside the loop you just use i to refer to the current array (row/line) of items:
strimportsplit(i) = strimport(i).Split(New Char() {vbTab})
Accessing an item can be done like so:
'strimportsplit(row)(column)
MessageBox.Show(strimportsplit(0)(1)) 'Displays "fff".
MessageBox.Show(strimportsplit(3)(2)) 'Displays "3".
You can also access an entire row if you'd like:
Dim ThirdRow As String() = strimportsplit(2)
MessageBox.Show(ThirdRow(0)) 'Displays "ccc".
strimportsplit = strimport(i).Split(New Char() {vbTab}) 'This line doesn't work
It doesn't work because you change the value of strimportsplit each time. You do not add more "rows" to it like what you probably think is happening.
If you really want to use a 2D array, you would need to know the length for both dimensions or you'd need to make some conversions afterward. You can calculate the lengths and create a 2D array by doing something like this:
Dim lines As String() = File.ReadAllLines(filePath)
Dim height As Integer = lines.Count - 1
' Calculating the max. number of "columns" in case they vary.
Dim width As Integer = lines.Select(Function(l) l.Split(vbTab).Count).Max - 1
Dim my2DArray(height, width) As String
For i = 0 To lines.Count - 1
Dim columns As String() = lines(i).Split(vbTab)
For j = 0 To columns.Count - 1
my2DArray(i, j) = columns(j)
Next
Next
Note that if the lines don't have the same number of "columns", some items in the array will be equal to null (or Nothing).
However, a much better way is to use a jagged array instead of a 2D array. You can achieve that using Linq by writing something as simple as:
Dim myJaggedArray As String()() = File.ReadAllLines(filePath).
Select(Function(l) l.Split(vbTab)).ToArray
A jagged array is an array of an array (array of a string array in your case) which you can access its values using arr(x)(y) instead of arr(x, y).
Another alternative to deal with this situation is to use any existing library that works with delimited files (comma separated, tab separated, etc.) instead of having to handle this by yourself. I would recommend using GenericParser which you can easily use to load data from delimited files into a DataTable. You can check my answer to another question for more about how to use it.
Instead of using a jagged array I'd use a List of String(). Here is your code slightly modified to illustrate.
Dim strimport() As String
strimport = IO.File.ReadAllLines("C:\test.txt")
Dim StrImportSplit As New List(Of String())
For Each ln As String In strimport 'iterate lines in file
StrImportSplit.Add(ln.Split(New Char() {ControlChars.Tab}))
Next
And a check
'check
For lidx As Integer = 0 To StrImportSplit.Count - 1 'rows
Dim l As New System.Text.StringBuilder
For cidx As Integer = 0 To StrImportSplit(lidx).Length - 1 'columns
l.Append(StrImportSplit(lidx)(cidx))
l.Append(" ")
Next
Debug.WriteLine(l)
Next
I have the following function:
Function get_equal_array_subset(column_label As String, _
loop_array() As Variant, _
values_array() As Variant)
' this function outputs an array of value from the values_array, based on a loop through the loop_array
' column_label is the first item in the array of the ouput array; i.e. the column lable of a new range
' loop_array is array being looped through and testing each value
' valus_array is the array from which values are taken with the test is met in the first array
' *** arrays have to be of equal lenght ***
Dim subset_array() As Variant
subset_array = Array(column_label)
Dim rows_dim As Long
Dim cols_dim As Integer
Dim agent_subset_counter As Long
agent_subset_counter = 0 ' counter to set the key for the new array
For rows_dim = 2 To UBound(loop_array, 1)
For cols_dim = 1 To UBound(loop_array, 2)
If loop_array(rows_dim, cols_dim) > 2 Then
agent_subset_counter = agent_subset_counter + 1 ' increase the subset counter by 1
ReDim Preserve subset_array(agent_subset_counter) ' resize the array account for the next id
subset_array(agent_subset_counter) = values_array(rows_dim, cols_dim) ' add the new id to the agent subset
End If
Next cols_dim
Next rows_dim
get_equal_array_subset = subset_array
End Function
Is there a way for me to make the If loop_array(rows_dim, cols_dim) > 2 Then a variable? Let's say I wanted the test to be > 3 or = 5 or non blank...etc.
I would go for the magic Application.Evaluate() method of the Application class. An example might be to define a series of tests into an array, let's say:
Dim myTests(4)
myTests(1) = "> 3"
myTests(2) = "= 5"
myTests(3) = "+3 < 5"
myTests(4) = "- 4 + sum(1,2) < 5"
Hence, using the simple statement:
If Application.Evaluate(loop_array(rows_dim, cols_dim) & myTests(j)) Then
Clearly, the variable j should be defined depending on the test you want to use and this kind of method would allow you to define several arrays of operators (one array for operators like +, - etc., another one for values like 3, 5 etc.)
NOTE If you don't know it yet, the Application.Evaluate() method will evaluate the expression and returning the result as Excel would do. It's basically using the same code that Excel uses to evaluate what you write in a cell:
Application.Evaluate("2+3") --> 5
Application.Evaluate("2 < 3") --> True
Application.Evaluate("IF(2=3,1,2)") --> 2
'etc.
If you wanted to make the "magic number" 2 into a variable, then you would use an array item in place of the 2.If, however, you wanted separate logic, then you use use a Select Case structure.
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.