VBA create dictionary aggregate values - vba

I have six variables, symbolizing three pairs (key/value). It will always be three pairs.
cb1 = 1: cb1value = 10
cb2 = 1: cb2value = 20
cb3 = 8: cb3value = 10
What I'm failing at is aggregating the values in a dictionary according to the key.
So in the above case the result would be:
1, (10, 20)
8, (10)
The end goal here is to use Sum(key) to get the total per key.
EDIT: Thanks for the replies so far. Maybe I'm just thinking too complicated. First I've put all the values in an array and then loop through it.
MyArray = Array(cb1, cb1value, cb2, cb2value, cb3, cb3value)
Now the keys are every 2 steps, so in my loop:
For i = 0 To 5 Step 2
If Not (keywords.Exists(MyArray(i))) Then
keywords.Add MyArray(i), Collection(MyArray(i + 1))
Else
'If the key exists, the value should be added to the existing key's collection. **But how?**
End If
Next i

For i = lbound(MyArray) To UBound(MyArray)-1 Step 2
If Not (keywords.Exists(MyArray(i))) Then keywords.Add MyArray(i), New Collection
keywords(MyArray(i)).Add MyArray(i + 1)
Next i
To get the sum of all entries in a collection:
Function SumCollection(col as Collection)
Dim rv As Double, i
For Each i in col
rv = rv + i
Next i
SumCollection = rv
End Function
If all you need is the sum though, you don't need the collection: just sum directly in the dictionary as you add each item.

Related

VBA Array determine where to put values next

I have a recordset from en SQL server. I don't know the exact amount of data I need to retrieve, hence I have created a dynamic array.
What I need to do, is to seperate and sort data when I put it in the array. But I don't know what best practice on this will be.
E.g. I have set of data with a customer ID in one column and revenue in the second. Lets say I only have 2 customers and have a list like the one below:
Customer ID Revenue
1 604
2 669
2 732
2 629
1 897
2 530
I would then like my array to have two dimensions (customer 1 and 2) and have a maximum lenght that matches with the maximum amount of purchases one customer has made. In this case, customer 2 have made four purchases and customer 1 have made two. Therefore my ideal array would be something like this: myArray(1 to 2, 4).
How will I do this best?
Then after I have defined my array, I would like to populate it with my data, but the data is not sorted, so how can I determine in what place I should put the data next? If that makes sence?
For example my initial thought was to run through the dataset and do something like this:
i = 1
do until dataset.eof
if dataset.field("customerid") = 1 then
myArray(1, i) = dataset.field("customerid").value
else if dataset.field("customerid") = 2 then
myArray(1, i) = dataset.field("customerid").value
end if
i = i + 1
dataset.movenext
loop
This is all fine and dandy, until the customer ID changes. If the first to rows are customer 1 then the data would be placed in myArray(1, 1) and myArray(1, 2). But then if the customer ID on the next row i customer 2, the first entry for customer 2 will be in myArray(2, 3) and not in myArray(2, 1) as I will desire.
Also with this, I will exceed the limits of the array if I have the array defined as per my first question :-)
Does this all make sense?
Thanks in advance :-)
You can use a scripting dictionary with the customer id as the key and an array of revenues as the value.
Untested:
dim dict as object, id, rev, tmp, k
set dict = createobject("scripting.dictionary")
do until dataset.eof
id = dataset.fields("customerid").Value
rev = dataset.fields("revenue").Value
if dict.exists(id) then
tmp = dict(id)
ub = ubound(tmp)+1
redim preserve tmp(0 to ub)
tmp(ub) = rev
dict(id) = tmp
else
dict(id) = Array(rev)
end if
dataset.movenext
loop
for each k in dict
debug.print k, join(dict(k),", ")
next k
I believe that arrays are not the best data structure for this goal. I would use a collection of classes. That gives great flexibility in both storing and sorting data. As an example, I created the following:
-in the worksheet (as data source, to replace your recordset):
-Code module Module1:
Option Explicit
Sub jzz()
Dim Customers As Collection
Dim cust As cls_customer
Dim i As Long
Dim arr() As Long
Set Customers = New Collection
i = 1
Do Until Cells(i, 1) = vbNullString
'check if the customer is already in the collection:'
For Each cust In Customers
If cust.id = Cells(i, 1) Then Exit For
Next cust
'check if the customer was found; if not, create new and add to collection'
If cust Is Nothing Then
Set cust = New cls_customer
cust.id = Cells(i, 1)
Customers.Add cust
End If
cust.Revenue = Cells(i, 2)
i = i + 1
Loop
For Each cust In Customers
Debug.Print cust.id, cust.Revenue_count
Next cust
Set Customers = Nothing
End Sub
-Class module cls_customer:
Option Explicit
Public id As Long
Private p_revenue_collection As Collection
Public Property Let Revenue(value As Long)
'accepts a long (value) and adds it to the collection'
p_revenue_collection.Add value
End Property
Public Property Get Revenue_count() As Long
Revenue_count = p_revenue_collection.Count
End Property
Private Sub Class_Initialize()
Set p_revenue_collection = New Collection
End Sub
The class holds only the revenue_count property, which returns the amount of entries in the collection, but you can add your own properties at will to return sorted data etc.

Looping through only columns containing values for specific row in dataTable

I am developing an application using Visual Basic 2010 for hydraulic calculations of a pipe network.
This application uses a lot of iterations and loops, depending on the user input and size of network. Most of the results have to be saved temporarily to be used for the next step of calculations.
Firstly, I used a DataGridView to save the results but as the number of iterations increased, the application became very slow.
Now I am trying to create a DataTable, then populate it with some initial results (this part was successful). The obtained DataTable has some columns that are not populated like so:
22 24 10
3 16 22 9 15
16 12 24 13
14 21 10 23 12 1
24 18 23 2 1
Other calculations are performed and a certain value (X) is obtained.
Now I am trying to loop through the columns of a specific row to check if the calculated value (X) equals to one of the values in those columns.
My question is: How can I loop through only the columns that have values (avoiding the columns containing NULL values) for a specific row?
I am a beginner in VB.net. I hope my question is clear as I didn't provide any code.
Thanks in advance for you help.
This is the initial code I used:
Results.DGVInitial.Rows.Clear()
Results.DGVFinal.Rows.Clear()
For m As Integer = 0 To NetworkLayout.DGVNetworkLayout.Rows.Count - 1
Results.DGVInitial.Rows.Add()
Next
Dim I As Integer = NetworkLayout.DGVNetworkLayout.Rows.Count - 1
Dim Sec(I), Ini(I) As Integer
Dim Hyd(I), Dia(I), Len(I) As Single
Dim Qsec(I), Qini(I), Vsec(I) As Single
Dim U(I), Y(I) As Single
Do
I = I - 1
Sec(I) = NetworkLayout.DGVNetworkLayout.Rows(I).Cells(0).Value
Ini(I) = NetworkLayout.DGVNetworkLayout.Rows(I).Cells(1).Value
Hyd(I) = NetworkLayout.DGVNetworkLayout.Rows(I).Cells(6).Value
Dia(I) = NetworkLayout.DGVNetworkLayout.Rows(I).Cells(4).Value
Len(I) = NetworkLayout.DGVNetworkLayout.Rows(I).Cells(3).Value
Dim V As Integer
V = Results.DGVRandomGen.Rows(TotalNum_Runs - 1).Cells(I).Value
Qsec(I) = 0
Dim q As Single = 0
For n As Integer = 0 To Results.DGVInitial.Rows.Count - 1
If Results.DGVInitial.Rows(n).Cells(1).Value = Sec(I) Then
q = Results.DGVInitial.Rows(n).Cells(0).Value
Qsec(I) = Qsec(I) + q
Else
Qsec(I) = Qsec(I)
End If
Next
If V = 1 Then ' if the hydrant is open
Qini(I) = Hyd(I) + Qsec(I)
Else ' if the hydrant is close
Qini(I) = Qsec(I)
End If
Results.DGVInitial.Rows(I).Cells(0).Value = Qini(I)
Results.DGVInitial.Rows(I).Cells(1).Value = Ini(I)
Results.DGVSectionDischarges.Rows(TotalNum_Runs - 1).Cells(I).Value = ini(I).ToString("F2")
Now instead of using
V = Results.DGVRandomGen.Rows(TotalNum_Runs - 1).Cells(I).Value
I would like to replace the "DGVRandomGen" with a DataTable called "DT_Random"
Like I said I am a beginner so I am not sure how to code it but it will be something like this:
For DT_Random.Rows (TotalNum_Runs - 1)
For Each col As DataColumn In DT_Random.Columns
If DT_Random.Rows(TotalNum_Runs - 1).Item(col) = I Then
Qini(I) = Hyd(I) + Qsec(I)
Else
Qini(I) = Qsec(I)
End If
Next
But I want to avoid Null values as not all columns are populated
Thanks
Maybe this will help you:
Dim myXvalue = 24
Dim myDataTable As New DataTable
myDataTable.Columns.Add("Col1")
myDataTable.Columns.Add("Col2")
myDataTable.Columns.Add("Col3")
myDataTable.Columns.Add("Col4")
myDataTable.Rows.Add(22, 24, 10, DBNull.Value)
myDataTable.Rows.Add(3, 16, 22, DBNull.Value)
myDataTable.Rows.Add(24, 18, DBNull.Value, 24)
For Each column As DataColumn In myDataTable.Columns
If IsDBNull(myDataTable.Rows(0).Item(column)) Then
MsgBox("DB Null Found At: " & column.ColumnName)
Continue For
End If
If myDataTable.Rows(0).Item(column) = myXvalue Then
MsgBox("Match: " & myDataTable.Rows(0).Item(column) & " found at " & column.ColumnName)
End If
Next column
Just a quick example, you may need to restructure it a bit, but at least it shows you how to access the values in your datatable by columns. I would do a function that passes a row index as a parameter and returns a boolean. Create two booleans inside the sub, one for dbnull existing in the row, and one for finding a matching value. If dbnull bool is false, and match value is true, then return true. Just make sure you loop all the columns and dont exit early.
If you need me to elaborate let me know.

Random numbers in array without any duplicates

I'm trying to randomize an array from numbers 0 to 51 using loops but I just cannot seem to pull it off. My idea was that
Generate a Random Number
Check if this random number has been used by storing the previous in an array
If this random number has been used, generate new random number until it is not a duplicate
If it's not a duplicate, store it
My attempt:
Dim list(51) As Integer
Dim templist(51) As Integer
For i As Integer = 0 To 51 Step 1
list(i) = i
Next i
Do While counter <= 51
p = rand.Next(0, 52)
templist(counter) = p
For n As Integer = 0 To 51 Step 1
p = rand.Next(0, 52)
If templist(n) = p Then
Do While templist(n) = p
p = rand.Next(0, 52)
Loop
templist(n) = p
Else
templist(n) = p
End If
Next
counter += 1
Loop
For n As Integer = 0 To 51 Step 1
ListBox1.Items.Add(templist(n))
Next
It will be a lot easier if you just have a list of all of the possible numbers (0 to 51 in your case), then remove the number from the list so it can't be picked again. Try something like this:
Dim allNumbers As New List (Of Integer)
Dim randomNumbers As New List (Of Integer)
Dim rand as New Random
' Fill the list of all numbers
For i As Integer = 0 To 51 Step 1
allNumbers.Add(i)
Next i
' Grab a random entry from the list of all numbers
For i As Integer = 0 To 51 Step 1
Dim selectedIndex as Integer = rand.Next(0, (allNumbers.Count - 1) )
Dim selectedNumber as Integer = allNumbers(selectedIndex)
randomNumbers.Add(selectedNumber)
allNumbers.Remove(selectedNumber)
' Might as well just add the number to ListBox1 here, too
ListBox1.Items.Add(selectedNumber)
Next i
If your goal is to get the numbers into ListBox1, then you don't even need the "randomNumbers" list.
EDIT:
If you must have an array, try something like this:
Function RandomArray(min As Integer, max As Integer) As Integer()
If min >= max Then
Throw New Exception("Min. must be less than Max.)")
End If
Dim count As Integer = (max - min)
Dim randomNumbers(count) As Integer
Dim rand As New Random()
' Since an array of integers sets every number to zero, and zero is possibly within our min/max range (0-51 here),
' we have to initialize every number in the array to something that is outside our min/max range.
If min <= 0 AndAlso max >= 0 Then
For i As Integer = 0 To count
randomNumbers(i) = (min - 1) ' Could also be max + 1
Next i
End If
Dim counter As Integer = 0
' Loop until the array has count # of elements (so counter will be equal to count + 1, since it is incremented AFTER we place a number in the array)
Do Until counter = count + 1
Dim someNumber As Integer = rand.Next(min, max + 1)
' Only add the number if it is not already in the array
If Not randomNumbers.Contains(someNumber) Then
randomNumbers(counter) = someNumber
counter += 1
End If
Loop
Return randomNumbers
End Function
This is good enough for your assignment, but the computer scientist in my hates this algorithm.
Here's why this algorithm is much less desirable. If zero is in your range of numbers, you will have to loop through the array at least 2N times (so 104+ times if you are going from 0 to 51). This is a best case scenario; the time complexity of this algorithm actually gets worse as the range of numbers scales higher. If you try running it from 0 to 100,000 for example, it will fill the first few thousand numbers very quickly, but as it goes on, it will take longer and longer to find a number that isn't already in the list. By the time you get to the last few numbers, you could potentially have randomly generated a few trillion different numbers before you find those last few numbers. If you assume an average complexity of 100000! (100,000 factorial), then the loop is going to execute almost ten to the half-a-millionth power times.
An array is more difficult to "shuffle" because it is a fixed size, so you can't really add and remove items like you can with a list or collection. What you CAN do, though, is fill the array with your numbers in order, then go through a random number of iterations where you randomly swap the positions of two numbers.
Do While counter <= 51
p = rand.Next(0, 52)
While Array.IndexOf(list, p) = -1
p = rand.Next(0, 52)
End While
counter += 1
Loop
Haven't written VB in about 5 years, but try this out:
Function GetRandomUniqueNumbersList(ByVal fromNumber As Integer, ByVal toNumber As Integer) As List(Of Integer)
If (toNumber <= fromNumber) Then
Throw New ArgumentException("toNumber must be greater than fromNumber", toNumber)
End If
Dim random As New Random
Dim randomNumbers As New HashSet(Of Integer)()
Do
randomNumbers.Add(random.Next(fromNumber, toNumber))
Loop While (randomNumbers.Count < toNumber - fromNumber)
Return randomNumbers.ToList()
End Function
Ok, that was painful. Please someone correct it if I made any mistakes. Should be very quick because it's using a HashSet.
First response to forum on stackoverflow - be gentle.
I was looking for a way to do this but couldn't find a suitable example online.
I've had a go myself and eventually got this to work:
Sub addUnique(ByRef tempList, ByVal n, ByRef s)
Dim rand = CInt(Rnd() * 15) + 1
For j = 0 To n
If tempList(j) = rand Then
s = True
End If
Next
If s = False Then
tempList(n) = rand
Else
s = False
addUnique(tempList, n, s)
End If
End Sub
Then call the sub using:
Dim values(15) As Byte
Dim valueSeen As Boolean = False
For i = 0 To 15
addUnique(values, i, valueSeen)
Next
This will randomly add the numbers 1 to 16 into an array. Each time a value is added, the previous values in the array are checked and if any of them are the same as the randomly generated value, s is set to true. If a value is not found (s=false), then the randomly generated value is added. The sub is recursively called again if s is still true at the end of the 'For' loop. Probably need 'Randomize()' in there somewhere.
Apologies if layout is a bit wobbly.

Get row index if some column value is equal to something

In this datatable there are no duplicates, I need the row index where column x value equals 2. I would do it like this:
Dim rowIndex As Integer = 0
For i = 0 To mtable.Rows.Count - 1
If mtable.Rows(i)("x") = 2 Then
rowIndex = i
Exit For
End If
Next
I will be calling this process multiple times per second. Is there a faster way to do this in .NET?
DataTable select could work, i think it should be faster than iterating over the collection of rows.
var index = mtable.Rows.IndexOf(mtable.Select("x = 2").FirstOrDefault());
Multiple times per second is a bit vague - tens or thousands?
You could create a hash table mapping the value of "x" to the row number:
Dim nLookups = mtable.Rows.Count - 1
Dim lookupHash As New Hashtable(nLookups)
For i = 0 To nLookups
lookupHash.Add(CInt(mtable.Rows(i)("x")), i)
Next
then
Dim rowSought As Integer = -1
If lookupHash.ContainsKey(2) Then
rowSought = lookupHash(2)
End If
Or if the range of possible values of "x" is suitable, you could use an array to map the value to the row number.

Ordering Outputted random numbers

I am making a program that outputs random numbers and then organizes them.
I am organizing the numbers so later I can add code to tell the user how many matching numbers he or she has received.
The program compiles fine, but then when I run the exe, after the first line of random numbers is outputted it crashes. The error I receive is:
the index is outside the boundaries of the array.
Any help at all would be gratefully appreciated.
Option Explicit On
Option Strict On
Imports System
Module Yahtzed
Sub Main()
Randomize()
Dim Index, Values, NumberOfPlayers,Temp as Integer
Dim order(index) as integer
Dim Last As Integer = 0 'to Order.Length-2
Console.Write("How many people will be playing Yahtzed?: ")
NumberOfPlayers = convert.toint32(Console.Readline)
Do while NumberOfPlayers > 0
Index = 0
Do until index = 5
Values = CInt(Int((6 * Rnd()) + 1))
Console.Write(" "&values)
Index += 1
Loop
Do Until Index = 0
If Order(Index + 1) < Order(index)
Temp = Order(Index + 1)
Order(Index + 1) = order(index)
Order(index) = Temp
Console.WriteLine(Order(Index))
End if
index -= 1
loop
Console.Writeline
NumberOfPlayers -= 1
Console.Writeline()
Loop
End Sub
End Module
The code doesn't really make sense as it is now. You create some random numbers, then you throw them away, and sort an array that never has been assigned anything. Also, the array only has one item, so it would not be able to hold the random values.
I think that you want to declare the array for five items, not one (as index is zero by the time you create the array):
Dim order(4) As Integer
Then put the random numbers in the array instead of putting them in a variable where each random number will replace the previous one:
Index = 0
Do until index = 5
order(index) = CInt(Int((6 * Rnd()) + 1))
Console.Write(" " & order(index))
Loop
When you sort the array, you start looking at index 6 (as the variable index is 5), which is outside the array. You would want to start at one item from the last in the array (i.e. at index 3). Then you loop until index is -1, otherwise you won't be comparing the two first items in the array.
Also, you have to continue sorting until there are no more swaps, just going through the array once doesn't make it sorted:
Dim swapped as Boolean = True
Do While swapped
index = 3
swapped = False
Do Until index = -1
If order(index + 1) < order(index)
temp = order(index + 1)
order(index + 1) = order(index)
order(index) = temp
swapped = True
End if
index -= 1
Loop
Loop
This sorting algorithm is called Bubble Sort.
There is also sorting built into the framework, if you want to use that instead:
Array.Sort(order)
If you would write out the values while sorting, you would get them several times over, so you do that after they are sorted:
index = 0
Do until index = 5
Console.Write(" " & order(index))
Loop