There any way to compare multiple variables in VBA? For example:
Dim x As Integer
Dim y As Integer
Dim z As Integer
x = 99
y = 2
z = 3
I would like to return the smallest of the values.
I understand I could use select case x > y for all possible permutations but that seems unwieldy for more than 3 variables.
I have tried the worksheet function
solution = Application.WorksheetFunction.Min(x, y, z)
but that returns 2 and I would like it to return the variable name to be passed to another function.
many thanks,
Edit: My apologies if this was confusing, I am still a VBA novice. Here's my problem a little more generally:
I have a list of codes that correspond to names, many names per code. I want to loop through every name per code and count the number of instances that name appears on a list and choose the name with the LEAST occurrences. (could be 0 or could be the same as another name). obviously if there were 2 names it would be easy to do a if x>y then but I'm stumped as for comparing more than 3. Thanks for reading.
Use a public array rather than multiple variables. This will make it easy to iterate through them all and get the highest value, as well as reference the variable with the highest value later on:
Public myArray(0 To 2) As Integer
Public index As Integer
Public Sub calcMin()
Dim i As Integer
Dim maxValue As Integer
myArray(0) = 99
myArray(1) = 2
myArray(2) = 3
For i = 0 To UBound(myArray)
If myArray(i) < maxValue Then
maxValue = myArray(i)
index = i
End If
Next i
End Sub
Function yourFunction(valueToPass As Integer)
'your function's code here
End Function
Then pass the variable to yourFunction like so: yourFunction(myArray(index))
Same idea as Mike's but with an example to call a sub with the min value found:
Sub main()
Dim arrComp(2) As Integer
arrComp(0) = 99
arrComp(1) = 2
arrComp(2) = 3
'It is important to initialize the tmpVal to a value from the array
'to consider the chance where negative and positive values are used
Dim tmpVal As Integer: tmpVal = arrComp(LBound(arrComp))
Dim i As Integer, minIndex As Integer
For i = LBound(arrComp) To UBound(arrComp)
If arrComp(i) < tmpVal Then
tmpVal = arrComp(i)
minIndex = i
End If
Next i
showMinVal arrComp(minIndex)
End Sub
Sub showMinVal(MinVal As Integer)
MsgBox "The min value is " & MinVal
End Sub
Or, a workaround if you want the name associated to the value, you could define a new Type:
'Types must be declared at the top of the module
Type tVarName
varName As String
varVal As Integer
End Type
Sub main()
Dim arrComp(2) As tVarName
arrComp(0).varName = "x"
arrComp(0).varVal = 99
arrComp(1).varName = "y"
arrComp(1).varVal = 2
arrComp(2).varName = "z"
arrComp(2).varVal = 3
Dim tmpVal As Integer: tmpVal = arrComp(LBound(arrComp)).varVal
Dim i As Integer, minIndex As Integer
For i = LBound(arrComp) To UBound(arrComp)
If arrComp(i).varVal < tmpVal Then
tmpVal = arrComp(i).varVal
minIndex = i
End If
Next i
showMinVal arrComp(minIndex)
End Sub
'Sub showing min value along with the name associated to it
Sub showMinVal(MinVal As tVarName)
MsgBox "The min value is " & MinVal.varName & " = " & MinVal.varVal
End Sub
Related
I am trying to write an Excel VBA function that will do two things. First, it will determine the number of movies in each genre and print it to the immediate window using the printMovieData function I have written. Secondly, it will return the genre that has the most number of movies using the FindMax function I have written. I have provided my codes for printMovieData, FindMax, and what I have so far for MoviesByGenre, however, I am not sure what I am doing wrong and am looking for help to get the function working. Currently, Excel is returning the #VALUE! error.
printMovieData:
Function printMovieData(title As String, arrayTopic, arrayOther)
printMovieData = ""
For i = 1 To UBound(arrayTopic)
Debug.Print arrayTopic(i) & " : " & arrayOther(i)
Next i
End Function
FindMax:
Function FindMax(valueArray, nameArray) As String
Dim i As Integer
Dim maxValue As Variant
maxValue = 0
For i = 1 To UBound(valueArray)
If valueArray(i) >= maxValue Then
maxValue = valueArray(i)
FindMax = nameArray(i)
End If
Next i
End Function
MoviesByGenre:
Function MoviesByGenre(genreRng As Range) As String
Dim i As Integer
Dim genreArray(1 To 4) As String
Dim countArray
genreArray(1) = Action
genreArray(2) = Comedy
genreArray(3) = Drama
genreArray(4) = Musical
For i = 1 To UBound(genreArray)
For j = 1 To genreRng.Count
If genreRng.Cells(j) = genreArray(i) Then
countArray(i) = countArray(i) + 1
End If
Next j
Next i
MoviesByGenre = printMovieData("Movies by Genre", genreArray, countArray)
MoviesByGenre = FindMax(countArray, genreArray)
End Function
TBH there are quite a lot of reasons why I wouldn't expect your code to work.
There are some assumptions made such as how you use genreRng.Count. This is assuming data to count is either one row or one column.
The following assumes that genreRng.Cells.Count, Ubound(genreArray) and UBound(countArray) are all the same. You don't ensure this.
There are missing variable declarations, no use of Option Explicit and a number of other things.
Overarching though, is that I think you want a different object to handle your count. This is where Collection and Scripting Dictionaries are very useful.
You can have the key as the genre and the count is held in the associated value. If the key already exists, i.e. a repeat genre, just add one to the existing count.
With that in mind, a starting point, might be something like (sorry, no error handling added):
Option Explicit
Public Sub test()
Dim genreCount As Object
Set genreCount = CreateObject("Scripting.Dictionary")
Set genreCount = MoviesByGenre(ActiveSheet.Range("A1:A3"), genreCount)
printMovieData "Movies by genre", genreCount
FindMax genreCount
End Sub
Public Function MoviesByGenre(ByRef genreRng As Range, ByVal genreCount As Object) As Object
Dim j As Long
For j = 1 To genreRng.Count 'assumes 1 column/row
Dim currentGenre As String
currentGenre = genreRng.Cells(j, 1)
If Not genreCount.Exists(currentGenre) Then
genreCount.Add currentGenre, 1
Else
genreCount(currentGenre) = genreCount(currentGenre) + 1
End If
Next j
Set MoviesByGenre = genreCount
End Function
Public Function printMovieData(ByVal title As String, ByVal genreCount As Object)
Dim key As Variant
Debug.Print title & vbCrLf 'put to next line
For Each key In genreCount.keys
Debug.Print key & " : " & genreCount(key)
Next key
End Function
Public Function FindMax(ByVal genreCount As Object) As String
Dim maxValue As Long
Dim maxGenre As String
Dim key As Variant
For Each key In genreCount.keys
If genreCount(key) > maxValue Then
maxValue = genreCount(key)
maxGenre = key
End If
Next key
Debug.Print vbNewLine & "Max genre is " & maxGenre & " with " & maxValue
End Function
Input and output:
Input:
Output:
I have an array that looks like this:
Dim values(1 To 3) As String
values(1) = Sheets("risk_cat_2").Cells(4, 6).Value
values(2) = Sheets("risk_cat_2").Cells(5, 6).Value
values(3) = Sheets("risk_cat_2").Cells(6, 6).Value
What I would like to do now is get the maximum value from all the values in string. Is there an easy way in VBA to fetch the max value from an array?
Is there an easy way in VBA to fetch the max value from an array?
Yes - if the values are numeric. You can use WorksheetFunction.Max in VBA.
For strings - this won't work.
Sub Test2()
Dim arr(1 To 3) As Long
arr(1) = 100
arr(2) = 200
arr(3) = 300
Debug.Print WorksheetFunction.Max(arr)
End Sub
Simple loop would do the trick
Dim Count As Integer, maxVal As Long
maxVal = Values(1)
For Count = 2 to UBound(values)
If Values(Count) > maxVal Then
maxVal = Values(Count)
End If
Next Count
The easiest way to retrieve the maximum (I can think of) is iterating through the array and comparing the values. The following two functions do just that:
Option Explicit
Public Sub InitialValues()
Dim strValues(1 To 3) As String
strValues(1) = 3
strValues(2) = "af"
strValues(3) = 6
Debug.Print GetMaxString(strValues)
Debug.Print GetMaxNumber(strValues)
End Sub
Public Function GetMaxString(ByRef strValues() As String) As String
Dim i As Long
For i = LBound(strValues) To UBound(strValues)
If GetMaxString < strValues(i) Then GetMaxString = strValues(i)
Next i
End Function
Public Function GetMaxNumber(ByRef strValues() As String) As Double
Dim i As Long
For i = LBound(strValues) To UBound(strValues)
If IsNumeric(strValues(i)) Then
If CDbl(strValues(i)) > GetMaxNumber Then GetMaxNumber = CDbl(strValues(i))
End If
Next i
End Function
Note, that each time a string (text) array is passed to the function. Yet, one function is comparing strings (text) while the other is comparing numbers. The outcome is quite different!
The first function (comparing text) will return (with the above sample data) af as the maximum, while the second function will only consider numbers and therefore returns 6 as the maximum.
Solution for Collection.
Sub testColl()
Dim tempColl As Collection
Set tempColl = New Collection
tempColl.Add 57
tempColl.Add 10
tempColl.Add 15
tempColl.Add 100
tempColl.Add 8
Debug.Print largestNumber(tempColl, 2) 'prints 57
End Sub
Function largestNumber(inputColl As Collection, indexMax As Long)
Dim element As Variant
Dim result As Double
result = 0
Dim i As Long
Dim previousMax As Double
For i = 1 To indexMax
For Each element In inputColl
If i > 1 And element > result And element < previousMax Then
result = element
ElseIf i = 1 And element > result Then
result = element
End If
Next
previousMax = result
result = 0
Next
largestNumber = previousMax
End Function
I searched the website but was not succesfful and tried doing some research on this but facing with " Type Mismatch" error.
I declared an array as integer type but the FILTER function seems to work only with STRING's. Can you please let me know how I can use the FILTER function for integers?
If UBound(Filter(CntArr(), count)) > 0 Then
msgbox "found"
End If
as i understand you need to know if specified count present in array. You can use for loop for it:
Dim found as Boolean
found = False
For i = 0 To UBound (CntArr())
If CntArr(i) = count Then
found = True
Exit For
End If
Next i
If found Then msgbox "found" End If
Below I have created IsIntegerInArray() function that returns boolean. Follow the two Subs for an example of integer array declaration. Declaring array as Integer should also prevent some unnecessary bugs caused by implicit data conversion.
Sub test_int_array()
Dim a() As Integer
ReDim a(3)
a(0) = 2
a(1) = 15
a(2) = 16
a(3) = 8
''' expected result: 1 row for each integer in the array
Call test_printing_array(a)
End Sub
Sub test_printing_array(arr() As Integer)
Dim i As Integer
For i = 1 To 20
If IsIntegerInArray(i, arr) Then
Debug.Print i & " is in array."
End If
Next i
End Sub
Function IsIntegerInArray(integerToBeFound As Integer, arr() As Integer) As Boolean
Dim i As Integer
''' incorrect approach:
''' IsIntegerInArray = (UBound(Filter(arr, integerToBeFound)) > -1) ' this approach searches for string, e.g. it matches "1" in "12"
''' correct approach:
IsIntegerInArray = False
For i = LBound(arr) To UBound(arr)
If arr(i) = integerToBeFound Then
IsIntegerInArray = True
Exit Function
End If
Next i
End Function
Which are the combinations that the sum of each digit is equal to 8 or less, from 1 to 88,888,888?
For example,
70000001 = 7+0+0+0+0+0+0+1 = 8 Should be on the list
00000021 = 0+0+0+0+0+0+2+1 = 3 Should be on the list.
20005002 = 2+0+0+0+5+0+0+2 = 9 Should not be on the list.
Sub Comb()
Dim r As Integer 'Row (to store the number)
Dim i As Integer 'Range
r = 1
For i = 0 To 88888888
If i = 8
'How can I get the sum of the digits on vba?
ActiveSheet.Cells(r, 1) = i
r = r + 1
End If
Else
End Sub
... Is this what you're looking for?
Function AddDigits(sNum As String) As Integer
Dim i As Integer
AddDigits = 0
For i = 1 To Len(sNum)
AddDigits = AddDigits + CInt(Mid(sNum, i, 1))
Next i
End Function
(Just remember to use CStr() on the number you pass into the function.
If not, can you explain what it is you want in a bit more detail.
Hope this helps
The method you suggest is pretty much brute force. On my machine, it ran 6.5min to calculate all numbers. so far a challenge I tried to find a more efficient algorithm.
This one takes about 0.5s:
Private Const cIntNumberOfDigits As Integer = 9
Private mStrNum As String
Private mRng As Range
Private Sub GetNumbers()
Dim dblStart As Double
Set mRng = Range("a1")
dblStart = Timer
mStrNum = Replace(Space(cIntNumberOfDigits), " ", "0")
subGetNumbers 8
Debug.Print (Timer - dblStart) / 10000000, (Timer - dblStart)
End Sub
Private Sub subGetNumbers(intMaxSum As Integer, Optional intStartPos As Integer = 1)
Dim i As Integer
If intStartPos = cIntNumberOfDigits Then
Mid(mStrNum, intStartPos, 1) = intMaxSum
mRng.Value = Val(mStrNum)
Set mRng = mRng.Offset(1)
Mid(mStrNum, intStartPos, 1) = 0
Exit Sub
End If
For i = 0 To intMaxSum
Mid(mStrNum, intStartPos, 1) = CStr(i)
subGetNumbers intMaxSum - i, intStartPos + 1
Next i
Mid(mStrNum, intStartPos, 1) = 0
End Sub
It can be sped up further by about factor 10 by using arrays instead of writing directly to the range and offsetting it, but that should suffice for now! :-)
As an alternative, You can use a function like this:
Function isInnerLowr8(x As Long) As Boolean
Dim strX As String, inSum As Long
isInnerLowr8 = False
strX = Replace(CStr(x), "0", "")
For i = 1 To Len(strX)
Sum = Sum + Val(Mid(strX, i, 1))
If Sum > 8 Then Exit Function
Next i
isInnerLowr8 = True
End Function
Now change If i = 8 to If isInnerLowr8(i) Then.
Hi I am new to VB and I have problems with using array. My code is like that.
This is class FindFactorsObject.vb
Public Sub FindFactors()
count = 0
temp = Convert.ToInt32(Math.Sqrt(_x))
For i As Integer = 1 To temp
If _x Mod i = 0 Then
ReDim array(count)
array(count) = i
count += 1
End If
Next
So I created an array and stored the results. Now I want to display each value in my array in Form.vb and if it is possible can somebody teach me how to make delay for each of the displayed value. Thanks very much
Always declare your variables, if possible to their exact types, you think they will take care of. When you say 'Now I want to display each value in my array in Form.vb' I understood literally: in the Form so, we will print them on your form
Public Sub FindFactors(_x As Integer)
Dim temp As Integer = Convert.ToInt32(Math.Sqrt(_x))
Dim l As New List(Of Integer)
For i As Integer = 1 To temp
If _x Mod i = 0 Then
l.add(i)
End If
Next
Dim pf As New PointF(20, 20)
For Each i As Integer In l
creategraphics.drawstring(i.ToString, New font(font.fontFamily, 24), brushes.cadetblue, pf)
pf = New PointF(pf.X, pf.Y + 30)
Next
End Sub