build excel array from data items and a multiplier - arrays

first question on this site.
Been coming here to bask in the warm glow of the knowledge on offer for years! Please be gentle with me. ;)
I'm not a programmer but can muddle my way around excel but I have a problem in excel that I'm struggling to find a solution to.
I need to take a set of data and turn it into an array (or list) of all the occurrences of that data. For example a set of data (A,B,C) and an instances value for each item (2,1,3).
What I need to do is take those two items and create an array of all occurrences.
Like this:-
Data,Instances
A,2
B,1
C,3
Total 6
Result
1,A
2,B
3,C
4,A
5,C
6,C
(I hope that's clear - my rating isn't high enough to post a screenshot)
So, in this example I have 2 As, 1 B and 3 Cs giving a total of 6 items. To create the result I've run through the list 6 times listing each data item if it still has an occurrence (but an array/list that was AABCCC would be just as valid). For the full data set there could be as many as 12 different data items with any number of occurrences each from 1 to 12.
Somehow I think I'm overcomplicating a simple process but for the life of me I can't get my head around achieving the result I need.

Say we put your data in column A:
and run this short macro:
Sub croupier()
Dim N As Long, K As Long, i As Long, ary(), bry()
Dim v As String
N = Cells(Rows.Count, "A").End(xlUp).Row
ReDim ary(1 To N)
ReDim bry(1 To N)
For i = 1 To N
v = Cells(i, "A").Value
cry = Split(v, ",")
ary(i) = cry(0)
bry(i) = CLng(cry(1))
Next i
K = 1
While Application.WorksheetFunction.Sum(bry) > 0
For i = 1 To N
If bry(i) <> 0 Then
Cells(K, "B").Value = ary(i)
bry(i) = bry(i) - 1
K = K + 1
End If
Next i
Wend
End Sub
Our result is this:
We repeatedly run down column A placing the values in column B until the count of an item reaches zero.
When the overall count of items is zero, we stop.

Related

Arrays in Excel VBA. At some point it puts NA instead of the value

I am trying to make a simple simulation in Excel VBA in which we roll two dices. What is the probability of getting "1"+"2" or "1"+"3"?
This is my code:
Sub ProbabilityMeyerArray()
Dim i As Long
Dim ArrayDices(1 To 100000, 1 To 2) As Variant
Dim ArrayResult(1 To 100000) As Variant
'Simulation
For i = 1 To 100000
ArrayDices(i, 1) = WorksheetFunction.RandBetween(1, 6)
ArrayDices(i, 2) = WorksheetFunction.RandBetween(1, 6)
If (ArrayDices(i, 1) = 1 And ArrayDices(i, 2) = 3) _
Or (ArrayDices(i, 1) = 1 And ArrayDices(i, 2) = 2) _
Or (ArrayDices(i, 1) = 3 And ArrayDices(i, 2) = 1) _
Or (ArrayDices(i, 1) = 2 And ArrayDices(i, 2) = 1) Then
ArrayResult(i) = 1
Else
ArrayResult(i) = 0
End If
Next i
'print the values to cells
Range("A1:B100000").Value = ArrayDices
Range("C1:C100000").Value = WorksheetFunction.Transpose(ArrayResult)
'Calculate the probability
Probability = Application.WorksheetFunction.Sum(ArrayResult) / 100000
MsgBox "The Probability is " & Probability
End Sub
The problem is that when I print the values from arrays to the cells, then in column C I have 0 and 1 (as it should be), but then from row 34465 I get NA. Here is a screenshot:
https://ibb.co/7jsjjJC
So, for some reason it starts putting NA instead of 0 and 1. The calculation does not work properly either, because the probability is too low, and I guess this is because it only counts the first 34464 zeros and ones, while dividing with 100 000. Can you help me understand what is wrong here? It seems to be a problem with (my understanding of) arrays, since I can run a similar simulation without arrays (by simply using cells), and it works.
Thanks in advance!
As #RaymondWu said in the comments, the problem is that the Transpose function has a limit to the length of the array it can manipulate. This limit is somewhere between 65k and 66k columns.
Indeed, your code will run as expected for 65k iterations.
You can easily avoid using transpose and to be honest I don't see the reason to use it in the first place.
Instead of declaring your array as Dim ArrayResult(1 To 100000) As Variant which by default makes it 1 row x 100000 columns, you can declare it as so:
Dim ArrayResult(1 To 100000, 1 To 1) As Variant
This will make it 100000 rows x 1 columns, which can now be written in a column in excel easily like so:
Range("C1:C100000").Value = ArrayResult
Of course you will also need to change the code accordingly where needed:
ArrayResult(i,1) = 1
Else
ArrayResult(i,1) = 0
A few other tips:
Always use Option Explicit at the very top of the code. It makes the declaration of variables mandatory and it helps to avoid mistakes
Always use explicit references. When referencing Ranges the best practice is to define the worksheet to which they belong e.g. ThisWorkbook.Worksheets("Sheet1").Range("C1:C100000").Value = ArrayResult

Aggregating part of a 2d array in a column in said array

I have a 2d array, with flexible dimensions:
arr_emissions(1 to n, 0 to m)
Where n is 22 or larger, and m is 6 or larger.
In the smallest case column m = 6 should contain the sum of columns m = 2 - 5.
I could ofcourse simply add them, but as the dimensions of the array are flexible I would like to implement a more robust method, that preferly doesn't loop over the entire array.
I was hoping to implement the native application.WorksheetFormula.Sum(). I saw an implementation in this answer, but that only works for complete rows or columns.
Example:
I have arr_emissions(0 to 111,1 to 6). It is populated in a loop from 1 to 111.
The data in the array is as follows:
(1,1) #3-4-2020# 'a date value
(1,2) 1,379777
(1,3) 0
(1,4) Empty
(1,5) Empty
Don't know if this helps, but this takes a source array v and then populates a new array w with the sum of columns 2-4 of the corresponding row of v.
Sub x()
Dim v, i As Long, w()
'just to populate source array
v = Range("A1").CurrentRegion.Value
ReDim w(1 To UBound(v, 1))
For i = 1 To UBound(w)
'each element of w is sum of columns 2-4 of corresponding row of v
w(i) = Application.Sum(Application.Index(v, i, Array(2, 3, 4)))
Next i
'write w to sheet
Range("G1").Resize(UBound(w)) = Application.Transpose(w)
End Sub
Thanks to the answer from SJR I found myself a working solution. This is all within a larger piece of code, but for this example I filled some variables with fixed numbers to match my example from my question.
Dim days as Integer
days = 111
Dim emissions_rows as Integer
emissions_cols = 6
ReDim arr_emissions(0 To days, 1 To emissions_cols) As Variant
Dim arr_sum As Variant
Dim sum_str As String
sum_str = "Transpose(row(2:" & emissions_rows - 1 & "))"
arr_sum = Application.Evaluate(sum_str) '= Array(2,3,4,5)
arr_emissions(emissions_index, emissions_cols) = Application.Sum(Application.Index(arr_emissions, emissions_index + 1, arr_sum))
The code writes a string to include the variables, so to take the second column untill the second to last column, which is then evaluated into an array.
That array is then used within the sum function, to only sum over those columns.
The result is then written to the last column of arr_emissions().
emissions_index is an index that is used to loop over the array.

VBA - struggling to calc and write StDev data into an array with a For Next loop

11/24/14 - as per below.....
Still trying to figure this out - might it be easier by creating a smaller array which could roll through the larger array? ...then any necessary calcs could be done on the entirety of the small array.
I cannot figure out how to isolate just a (rolling) subset of an array. The rolling subset could be used for moving averages, standard devs, max/min, etc.
11/21/14 - I have made several attempts, this is the latest iteration. It shouldn't produce meaningful output until the minimum periods have been looped thru (stdev_periods = 10).
--pct_chg_array() is an array which holds percent change data from i=2 to i = 2541... declared as variant
--stdev_periods = 10 ...declared as integer
--i is a counter ...declared as integer
--stdev_array() is an empty array which I hope to populate with a standard deviation calculation for a rolling n period range ...declared as variant
--Option Base 1 and Option Explicit are on
For i = 2 To 2541
If IsNumeric(i) And i <> 0 Then
stdev_array(i, 1) = Application.WorksheetFunction.stdev(Range(pct_chg_array(i, 1).Offset(-stdev_periods, 0), pct_chg_array(i, 0)))
Else
stdev_array(i, 1) = 0
End If
Next i
Any guidance would be immensely appreciated. Thanks!
----EDIT----
Just to simplify, this is how I would express it in a worksheet formula...
=IF(ISNUMBER(OFFSET($E3,-stdev_periods+1,0)),STDEV(OFFSET($E3,0,0,-stdev_periods)),0)
...with "stdev_periods" = 10 and column E holding 1 period %chg data (ie =$E3/$E2-1).
Put this function in the module:
Public Function Slice(vntInputArray As Variant, lngStartIndex As Long, lngEndIndex As Long)
'Use to return an arbitrary-sized subset from a 1 dimensional array.
'Assumes developer is using Option Base 1
Dim vntSubArray() As Variant, lngInputIndex As Long
Dim lngElementCountIndex As Long: lngElementCountIndex = 1
For lngInputIndex = lngStartIndex To lngEndIndex
ReDim Preserve vntSubArray(lngInputIndex)
vntSubArray(lngElementCountIndex) = vntInputArray(lngInputIndex)
lngElementCountIndex = (lngElementCountIndex + 1)
Next lngInputIndex
Slice = vntSubArray
End Function
Adding the function to your code:
For i = 2 To 2541
If IsNumeric(i) And i > stdev_periods Then 'Using greater than to account for Option Base 1
stdev_array(i, 1) = WorksheetFunction.stdev(Slice( pct_chg_array, (i -stdev_periods), i))
Else
stdev_array(i, 1) = 0
End If
Next i

Intersection of the Arraylists in VB

I've a legacy code base where I've four ArraysLists (different sizes). I want to compare these four arraylists and save the same values in a separate Array/Arraylist.
The arrays can have same values multiple times since ordering is not important. You can say that I just need the intersection of the ArrayLists.
The following code works, but of-course this is not the best way to do, looping on all the arrays-
For i = 0 To arr.Count - 1 Step 1
For j = 0 To arr1.Count - 1 Step 1
If arr.Item(i) = arr1.Item(j) Then
For k = 0 To arr2.Count - 1 Step 1
If arr.Item(i) = arr2.Item(k) Then
For l = 0 To arr3.Count - 1 Step 1
If arr.Item(i) = arr3.Item(l) Then
// the value arr.Item(i) exists in all 4 arrys
// save this to another array
End If
Next
End If
Next
End If
Next
Next
Since my arrayList size could be in thousands, that's not the way I want to know how should I sort out this.
Thanks.
PS. Sorry if this is a duplicate question, since I was not able search this anywhere (I'm new to VB).
you could use ArrayList.Contains to shorten / simplify things:
For i As Integer = 0 To arr.Count - 1
If Arr1.Contains(arr(i)) AndAlso Arr2.Contains(arr(i)) _
AndAlso Arr3.Contains(arr(i)) AndAlso Arr4.Contains(arr(i)) Then
// the value arr(i) exists in all 4 arrayLISTS
// save this to another array
End If
Next
Probably wont be a lot different in speed, but the code is sure easier to read. NB: AndAlso is important in this because it short circuits the later tests when it the result is false.

Excel- make array from votes on a score

I'm a whiz at Matlab, but apparently I can't figure out excel for my life today. I have a spreadsheet where I keep track of votes. So I record x number of votes for each score, i.e. on a scale of 1 to 5, 3 people voted 4, 2 people voted 3, and 1 person voted 1. I want to find the median of these votes, but I need to turn them into an array first, otherwise I'm just taking the median of the numbers of votes. I'm having trouble with getting arrays to work in this case. I need to build an array, with the above example, that looks like {4 4 4 3 3 1}, and then I can take the median of that (I assume I can just use the regular median function on an array?).
I realize the problem here is that I don't really know excel very well. So I guess I'm just asking for an answer, which is frowned upon when I can't show much work myself. But can someone give me a hint?
This one intrigued me, I'm sure there is a way to do this with an array formula but they have never been my strong point. For the time being here is a VBA solution:
Function MedianArray(rngScore As Range, rngCount As Range) As Double
Dim arrS() As Variant, arrC() As Variant, arrM() As Variant
Dim i As Integer, j As Integer, k As Integer
Dim d As Double
arrS = rngScore
arrC = rngCount
d = WorksheetFunction.Sum(rngCount)
ReDim arrM(1 To d, 1 To 1)
k = 1
For i = 1 To UBound(arrS, 2)
For j = 0 To arrC(1, i) - 1
arrM(k, 1) = arrS(1, i)
k = k + 1
Next j
Next i
MedianArray = WorksheetFunction.Median(arrM())
End Function
Given you say you don't know much about VBA here's how you do it:
From Excel press Alt + F11 to open the VB Editor
In the VB Editor menus select Insert -> Module
Paste in the code above
In the cell where you need median value type =MedianArray(B1:F1,B2:F2), assuming your scores are in row 1 columns B through F and the counts are directly below.
Hope this helps.
I'll let someone else post a VBA solution, but here's what I did using just formulas:
A B C D E
1 Running Total: 1 1 3 6 6 Median
2 Greater/lesser: < < = > > 3.5
3 Values: 1 2 3 4 5
4 Counts: 1 2 3
Rows 3 and 4 are your original values and counts of values. Row 1 is the running total of the counts, going from left to right. Row 2 represents whether row 1 is greater than, lesser than, or equal to the total sum of the counts row.
If there's no = in row 2, then you just need to get the value from the first column with a >. This is achieved with an HLookup.
If there is an = in row 2, then you need to get the average of the value in the = column and the value of the first > column.
See it in action
I'd like to know if there's a more elegant way!

Resources