I have an array of integers in VBA from which I would like to get the upper and lower quartiles.
I would like to use this method to get them: https://msdn.microsoft.com/en-us/library/office/ff836118.aspx
The documentation suggests you can use an array to do this, but when I try to run my code (below) I get an error saying Unable to get the Quartile property of the WorksheetFunction class
Please assist.
Dim totalsalesthatday() As String
Dim doINeedTo As Boolean
Dim totalsalesthatdayAverage As Integer
Dim randomnumberthingy As Integer
Dim quartile1 As Integer
Dim quartile3 As Integer
Dim iqr As Integer
Dim upper As Integer
Dim lower As Integer
quantity = 0
For Each queryaddress In worksheetname.Range("A2:A21")
query = queryaddress.Value
offsetnum = 0
If offsetnum = 0 Then
doINeedTo = True
End If
For Each daysoftheweek In Sheets
quantity = 0
If InStr(1, daysoftheweek.Name, worksheetnamename, vbTextCompare) > 0 And daysoftheweek.ListObjects.Count > 0 Then
Set itemaddress = daysoftheweek.Columns(5).Find(query, , xlValues, xlWhole)
If Not itemaddress Is Nothing Then
firstAddress = itemaddress.Address
Do
Set itemrow = itemaddress.EntireRow
quantity = quantity + itemrow.Columns(6).Value
Set itemaddress = daysoftheweek.Columns(5).FindNext(itemaddress)
Loop While Not itemaddress Is Nothing And itemaddress.Address <> firstAddress
End If
offsetnum = offsetnum + 1
ReDim Preserve totalsalesthatday(offsetnum)
totalsalesthatday(offsetnum) = daysoftheweek.ListObjects.Item(1).ListRows.Count
queryaddress.Offset(0, offsetnum).Value = quantity
worksheetname.Range("A1").Offset(0, offsetnum).Value = daysoftheweek.Name
End If
Next
If doINeedTo Then
quartile1 = WorksheetFunction.Quartile(totalsalesthatday, 1)
quartile3 = WorksheetFunction.Quartile_Inc(totalsalesthatday, 3)
iqr = quartile3 - quartile1
upper = quartile3 + (iqr * 1.5)
lower = quartile1 - (iqr * 1.5)
The error in question is at this line: quartile1 = WorksheetFunction.Quartile(totalsalesthatday, 1)
The .Quartile function parameters are an array and a double. Try changing your data types.
Related
Main point of this function is to return the most common movie genre.
Function MoviesByGenre(genreRng As Range) As String
Dim genreList(1 To 4) As String
Dim current As Integer
current = 1
For i = 1 To genreRng.count
Dim found As Integer
found = 0
For j = 1 To current
If genreList(j) = genreRng.Cells(i) Then
found = 1
Exit For
End If
Next j
If found = 0 Then
genreList(current) = genreRng.Cells(i)
current = current + 1
End If
Next i
Dim genreCount(1 To 4) As Integer
For i = 1 To 4
Dim count As Integer
count = 0
For j = 1 To genreRng.count
If genreRng.Cells(j) = genreList(i) Then
count = count + 1
End If
Next j
genreCount(i) = count
Next i
MoviesByGenre = FindMax(genreCount, genreList)
End Function
Now my FindMax function looks like this:
Function FindMax(valueArray, nameArray) As String
Dim max As Double
max = valueArray(LBound(valueArray))
For i = LBound(valueArray) + 1 To UBound(valueArray)
If valueArray(i) > valueArray(max) Then
max = i
End If
Next i
FindMax = nameArray(max)
End Function
FindMax appears to work well in other areas, but depending on the range I use for MoviesByGenre, it may or may not work. (sometimes it'll give me #VALUE!, other times it'll give me the actual most common movie genre, and i'm not sure why.) I'm using Excel 2016 for MacOS.
Do you mean something like that
Sub Test()
Dim a As Variant
a = Range("A1:A7").Value
MsgBox FindMax(a)
End Sub
Function FindMax(valueArray) As String
Dim max As Double
Dim i As Long
max = valueArray(LBound(valueArray), 1)
For i = LBound(valueArray) + 1 To UBound(valueArray)
If valueArray(i, 1) > max Then
max = valueArray(i, 1)
End If
Next i
FindMax = max
End Function
I am writing a user-defined function in excel vba. So this new function:
takes 4 input value
some calculation to generate into 8 numbers. ( 2 arrays - each array has 4 numbers)
do a chisquare test
return 1 output value
Code:
Sub test()
Dim A, B, C, D As Variant
A = 33
B = 710
C = 54
D = 656
'Observed Value
Dim O_A As Variant
Dim O_B As Variant
Dim O_V As Variant
Dim O_D As Variant
'Define Observer Value
O_C_A = 'Some Calucation'
O_C_B = 'Some Calucation'
O_T_C = 'Some Calucation'
O_T_C = 'Some Calucation'
'Expected Value
Dim E_C_A As Variant
Dim E_C_B As Variant
Dim E_T_C As Variant
Dim E_T_D As Variant
'Define Expected Value
E_C_A = 'Some Calucation'
E_C_B = 'Some Calucation'
E_T_C = 'Some Calucation'
E_T_D = 'Some Calucation'
'Create array(2x2)
Dim Chi_square_result As Variant
Dim my_array(1, 1)
my_array(0, 0) = O_C_Mesaurement
my_array(0, 1) = O_C_Balance
my_array(1, 0) = O_T_Measurement
my_array(1, 1) = O_T_Balance
Dim my_array2(1, 1)
my_array2(0, 0) = E_C_Mesaurement
my_array2(0, 1) = E_C_Balance
my_array2(1, 0) = E_T_Measurement
my_array2(1, 1) = E_T_Balance
'Create a chi square test formula'
Dim formula(1 To 5) As String
formula(1) = "CHITEST("
formula(2) = my_array
formula(3) = ","
formula(4) = my_array2
formula(5) = ")"
'Chi Square
Chi_square_result = evaluate(Join(formula, ""))
end sub
It gives a runtime error '13', saving type mismatch. This is because of the concatenation of the formula.
If you are writing a function, you have your format wrong.
Function Chi_square_result(A as Long, B as Long, C as Long, D as Long) as Double
'All your manipulations here
Chi_square_result = (Your math equation)
End Function
You also never defined my_array1, I am assuming it is supposed to be where you typed 'my_array'. I also do not think Join is your best bet. You are trying to do an awful lot of array manipulation, and I think your dimensions are getting you. It would be better to do it in a more straight forward way.
The evaluate is expecting worksheet cell ranges. Use the Excel Application object or WorksheetFunction object to compute the function within VBA.
This proofs out.
Dim dbl As Double
Dim my_array1(1, 1)
my_array1(0, 0) = 1
my_array1(0, 1) = 2
my_array1(1, 0) = 3
my_array1(1, 1) = 4
Dim my_array2(1, 1)
my_array2(0, 0) = 2
my_array2(0, 1) = 3
my_array2(1, 0) = 4
my_array2(1, 1) = 5
dbl = Application.ChiTest(my_array1, my_array2)
Debug.Print dbl
Result from the VBE's Immediate window: 0.257280177154182.
Right, so using Python I would create a multidimensional list and set the values on one line of code (as per the below).
aryTitle = [["Desciption", "Value"],["Description2", "Value2"]]
print(aryTitle[0,0] + aryTitle[0,1])
I like the way I can set the values on one line. In VBA I am doing this by:
Dim aryTitle(0 To 1, 0 To 1) As String
aryTitle(0, 0) = "Description"
aryTitle(0, 1) = "Value"
aryTitle(1, 0) = "Description2"
aryTitle(1, 1) = "Value2"
MsgBox (aryTitle(0, 0) & aryTitle(0, 1))
Is there a way to set the values in one line of code?
Not natively, no. But you can write a function for it. The only reason Python can do that is someone wrote a function to do it. The difference is that they had access to the source so they could make the syntax whatever they like. You'll be limited to VBA function syntax. Here's a function to create a 2-dim array. It's not technically 'one line of code', but throw it in your MUtilities module and forget about it and it will feel like one line of code.
Public Function FillTwoDim(ParamArray KeyValue() As Variant) As Variant
Dim aReturn() As Variant
Dim i As Long
Dim lCnt As Long
ReDim aReturn(0 To ((UBound(KeyValue) + 1) \ 2) - 1, 0 To 1)
For i = LBound(KeyValue) To UBound(KeyValue) Step 2
If i + 1 <= UBound(KeyValue) Then
aReturn(lCnt, 0) = KeyValue(i)
aReturn(lCnt, 1) = KeyValue(i + 1)
lCnt = lCnt + 1
End If
Next i
FillTwoDim = aReturn
End Function
Sub test()
Dim vaArr As Variant
Dim i As Long
Dim j As Long
vaArr = FillTwoDim("Description", "Value", "Description2", "Value2")
For i = LBound(vaArr, 1) To UBound(vaArr, 1)
For j = LBound(vaArr, 2) To UBound(vaArr, 2)
Debug.Print i, j, vaArr(i, j)
Next j
Next i
End Sub
If you supply an odd number of arguments, it ignores the last one. If you use 3-dim arrays, you could write a function for that. You could also write a fancy function that could handle any dims, but I'm not sure it's worth it. And if you're using more than 3-dim arrays, you probably don't need my help writing a function.
The output from the above
0 0 Description
0 1 Value
1 0 Description2
1 1 Value2
You can write a helper function:
Function MultiSplit(s As String, Optional delim1 As String = ",", Optional delim2 As String = ";") As Variant
Dim V As Variant, W As Variant, A As Variant
Dim i As Long, j As Long, m As Long, n As Long
V = Split(s, delim2)
m = UBound(V)
n = UBound(Split(V(0), delim1))
ReDim A(0 To m, 0 To n)
For i = 0 To m
For j = 0 To n
W = Split(V(i), delim1)
A(i, j) = Trim(W(j))
Next j
Next i
MultiSplit = A
End Function
Used like this:
Sub test()
Dim A As Variant
A = MultiSplit("Desciption, Value; Description2, Value2")
Range("A1:B2").Value = A
End Sub
I have a function in VBA that is supposed to sort text based on a "Bubble sort". If the text were just text then it would be fine, but my text is actually an alpha numeric string. I tried to rewrite it to account for the number part but something is still off and I can't seem to figure out what. Please help!!
Dim alphaCurr As String
Dim alphaNext As String
Dim rowCurr As FsChartRow
Dim rowNext As FsChartRow
Dim c As Integer
Dim n As Integer
Dim vTemp As Variant
For c = 1 To rows.count - 1
Set rowCurr = rows(c)
alphaCurr = GetAlpha(rowCurr.label)
For n = c + 1 To rows.count
Set rowNext = rows(n)
alphaNext = GetAlpha(rowNext.label)
If alphaCurr > alphaNext Then
Set vTemp = rows(n)
rows.Remove n
rows.Add vTemp, , c
End If
Next n
Next c
Dim numCurr As Integer
Dim numNext As Integer
Dim loopCount As Integer
For c = 1 To rows.count - 1
Set rowCurr = rows(c)
alphaCurr = GetAlpha(rowCurr.label)
numCurr = GetNumeric(rowCurr.label)
For n = c + 1 To rows.count
Set rowNext = rows(n)
alphaNext = GetAlpha(rowNext.label)
numNext = GetNumeric(rowNext.label)
If alphaCurr = alphaNext Then
If numCurr > numNext Then
Set vTemp = rows(n)
rows.Remove n
rows.Add vTemp, , c
End If
End If
Next n
Next c
The results I am getting are as follows:
"BK1"
"BK2"
"FB1"
"FB4"
"FB3"
"FB5"
"FB6"
"FB2"
"FJ2"
"FJ1"
"FJ3"
"FJ4"
"..."
"FJ15"
"RB1"
"H1"
"H2"
Thank for your help!
I have found a solution to my problem. I still could not get the bubble sort to work, so I created my own, that takes no more time to run then the bubble sort. I'll post in case it helps anyone.
Private Function SortFsChartRow(collection As collection) As collection
Dim min As Integer
Dim max As Integer
Dim x As Integer
Dim y As Integer
Dim rowCurr As FsChartRow
Dim numCurr As Integer
Dim rowMin As FsChartRow
Dim rowMax As FsChartRow
Dim search As Integer
Dim sorted As collection
Set sorted = New collection
min = 100
max = 0
For x = 1 To collection.count
Set rowCurr = collection(x)
numCurr = GetNumeric(rowCurr.label)
If numCurr > max Then
max = numCurr
Set rowMax = rowCurr
End If
If numCurr < min Then
min = numCurr
Set rowMin = rowCurr
End If
Next x
search = min
For y = 0 To max
For x = 1 To collection.count
Set rowCurr = collection(x)
numCurr = GetNumeric(rowCurr.label)
If numCurr = search Then
sorted.Add rowCurr
Exit For
End If
Next
search = search + 1
Next y
Set SortFsChartRow = sorted
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.