Can a logic test for an `if` statement be a variable in excel vba? - excel

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.

Related

How do I instantiate a dynamic, empty array and add its first element?

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.

Visual Basic load file to a string(,) separated by tabs

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

VBA Greater Than Function Not Working

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

Building Variable Names with Concatenate

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!

Subscripts (font) in excel vba

I'm trying to populate an array which is composed of greek letters followed by a subscript "1". I already have the greek letters part:
Dim variables(), variables_o
j = 0
For i = 1 To 25
If i = 13 Or i = 15 Then
Else
j = j + 1
ReDim Preserve variables(j)
variables(j) = ChrW(944 + i)
End If
Next
But I'm having trouble with the subscript part. I figure that if I could use the with ... end with feature then I could do it but I'm having trouble figuring out what objects the with ... end with can take. On this website they say:
With...End With Statement (Visual Basic)
The data type of objectExpression can be any class or structure type or even a Visual Basic elementary type such as Integer.
But I don't know what that means. If could do something like this:
dim one as string
one = "1"
with one
font.subscript = true
end with
Then I could figure out how to do what I want. But the with feature does not seem to act on strings. The problem I'm having is that most of the advice for fonts somewhere along the line use the cell method but I want to populate an array, so I'm having trouble. Again what I would ideally like to do is create some dimension which is simply a subscripted one and then alter my array as follows:
Dim variables(), variables_o
j = 0
For i = 1 To 25
If i = 13 Or i = 15 Then
Else
j = j + 1
ReDim Preserve variables(j)
variables(j) = ChrW(944 + i) & subscript_one
End If
Next
To my knowledge, there are no out-of-the-box methods or properties to store the font.Subscript property of a character or series of characters within a string that also contains the characters.
You could use inline tags, like in HTML, to indicate where the subscript begins and ends. For example:
variables(j) = ChrW(944 + i) & "<sub>1</sub>"
Then, when you write out variable, you would parse the string, remove the tags and set the font.Subscript property accordingly.
However, if you're always appending a '1' to each Greek letter, I would just append it to the string, then set the font.Subscript property on the last character of the string when outputting it. For example:
variables(j) = ChrW(944 + i) & "1"
...
For j = 0 to Ubound(variables)
With Worksheets("Sheet1").Cells(j + 1, 1)
.Value = variables(j)
.Characters(Len(variables(j)), 1).Font.Subscript = True
End With
Next j
If you're writing to something other than a cell in a worksheet, it has to support Rich-Text in order for the subscript to show, e.g. a Rich-Text enabled TextBox on a user form. You should be able to use the .Characters object on those controls in a similar manner.
See MSDN-Characters Object for more information.

Resources