How to shuffle a list on a random order? - vb.net-2010

How can I change the order of data in a list on a random order (Shuffle). easiest method with the least coding effort without definition of new functions or sub please.

I usually tag the items with random data and sort that. You can implement the shuffle directly, but that's more work - especially proving the algorithm actually shuffles randomly...

Well, I just made this code snippet here for a future reference, if you want to use a list just replace all instances of "Stack" with "List" and make sure to change ".Push" to ".Add" and it should work fine. To be honest I'm surprised a shuffle function isn't built in.
Dim Deck As New Stack
Sub Main()
For i As Integer = 1 To 10
Deck.Push("Card #" & i)
Next
Do
Console.Clear()
For i As Integer = 0 To Deck.Count - 1
Console.WriteLine(Deck(i))
Next
Console.ReadKey(True)
Shuffle()
Loop
End Sub
Private Sub Shuffle()
Dim NewDeck As New Stack
Dim i As Integer
Dim s As String 'Change type depending on what is in your stack.
Dim r As New Random
Do
i = r.Next(0, Deck.Count)
s = Deck(i)
'Stops you getting several of one item and then none of others, etc.
If Not NewDeck.Contains(Deck(i)) Then
NewDeck.Push(s)
End If
Loop Until NewDeck.Count = Deck.Count
Deck = NewDeck
End Sub

Related

Random() doesn't seem to be so random at all

Random() doesn't seem to be so random at all, it keeps repeating the pattern all the time.
How can I make this "more" random?
Dim ioFile As New System.IO.StreamReader("C:\names.txt")
Dim lines As New List(Of String)
Dim rnd As New Random()
Dim line As Integer
While ioFile.Peek <> -1
lines.Add(ioFile.ReadLine())
End While
line = rnd.Next(lines.Count + 0)
NAMES.AppendText(lines(line).Trim())
ioFile.Close()
ioFile.Dispose()
Clipboard.SetText(NAMES.Text)
This works fine for me. I changed a few things like implementing a using block, removed a redundant addition of 0, and added a loop to test 100 times out to debug. a sample of 200 that you are just "eyeballing" is not enough to say that a random sequence is "not working".
Using ioFile As New System.IO.StreamReader("C:\names.txt")
Dim lines As New List(Of String)
Dim rnd As New Random()
Dim line As Integer
While ioFile.Peek <> -1
lines.Add(ioFile.ReadLine())
End While
For i As Integer = 1 To 100
line = rnd.Next(lines.Count)
Debug.WriteLine(lines(line).Trim())
Next
End Using
You don't need a stream reader to read a text file. File.ReadAllLines will return an array of lines in the file. Calling .ToList on this method gets you the desired List(Of String)
We will loop through the length of the list in a for loop. We subtract one because indexes start at zero.
To get the random index we call .Next on our instance of the Random class that was declared outside the method (a form level variable) The .Next method is inclusive of the first variable and exclusive of the second. I used a variable to store the original value of lines.Count because this value will change in the loop and it would mess with for loop if we used lines.Count -1 directly in the To portion of the For.
Once we get the random index we add that line to the TextBox and remove it from the list.
Private Sub ShuffleNames()
Dim index As Integer
Dim lines = File.ReadAllLines("C:\Users\xxx\Desktop\names.txt").ToList
Dim loopLimit = lines.Count - 1
For i = 0 To loopLimit
index = rnd.Next(0, lines.Count)
TextBox1.AppendText(lines(index).Trim & Environment.NewLine)
lines.RemoveAt(index)
Next
End Sub

Visual Basic: loaded parallel list boxes with text file substrings, but now items other than lstBox(0) "out of bounds"

The text file contains lines with the year followed by population like:
2016, 322690000
2015, 320220000
etc.
I separated the lines substrings to get all the years in a list box, and all the population amounts in a separate listbox, using the following code:
Dim strYearPop As String
Dim intYear As Integer
Dim intPop As Integer
strYearPop = popFile.ReadLine()
intYear = CInt(strYearPop.Substring(0, 4))
intPop = CInt(strYearPop.Substring(5))
lstYear.Items.Add(intYear)
lstPop.Items.Add(intPop)
Now I want to add the population amounts together, using the .Items to act as an array.
Dim intPop1 As Integer
intPop1 = lstPop.Items(0) + lstPop.Items(1)
But I get an error on lstPop.Items(1) and any item other than lstPop.Items(0), due to out of range. I understand the concept of out of range, but I thought that I create an index of several items (about 117 lines in the file, so the items indices should go up to 116) when I populated the list box.
How do i populate the list box in a way that creates an index of list box items (similar to an array)?
[I will treat this as an XY problem - please consider reading that after reading this answer.]
What you are missing is the separation of the data from the presentation of the data.
It is not a good idea to use controls to store data: they are meant to show the underlying data.
You could use two arrays for the data, one for the year and one for the population count, or you could use a Class which has properties of the year and the count. The latter is more sensible, as it ties the year and count together in one entity. You can then have a List of that Class to make a collection of the data, like this:
Option Infer On
Option Strict On
Imports System.IO
Public Class Form1
Public Class PopulationDatum
Property Year As Integer
Property Count As Integer
End Class
Function GetData(srcFile As String) As List(Of PopulationDatum)
Dim data As New List(Of PopulationDatum)
Using sr As New StreamReader(srcFile)
While Not sr.EndOfStream
Dim thisLine = sr.ReadLine
Dim parts = thisLine.Split(","c)
If parts.Count = 2 Then
data.Add(New PopulationDatum With {.Year = CInt(parts(0).Trim()), .Count = CInt(parts(1).Trim)})
End If
End While
End Using
Return data
End Function
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim srcFile = "C:\temp\PopulationData.txt"
Dim popData = GetData(srcFile)
Dim popTotal = 0
For Each p In popData
lstYear.Items.Add(p.Year)
lstPop.Items.Add(p.Count)
popTotal = popTotal + p.Count
Next
' popTotal now has the value of the sum of the populations
End Sub
End Class
If using a List(Of T) is too much, then just use the idea of separating the data from the user interface. It makes processing the data much simpler.

Can I create variables dynamically based on other variables?

I'm working on a VBA module to process lists of quote items. My current boggle is trying to stack full or partial sets of things from the quote lists, and I'm trying to figure out how to keep track of them.
The item lists do not have a consistent number of items; one might be a single item, another might be a hundred.
The system divides the cargo into four broad types (Pipes, Plates, Beams and Other) for the sake of selecting which calculator logic to use.
Is there any way to create variables on the fly to keep track of individual line items? For instance, deploying a spot of pseudocode:
Public Qty & "_" & Class & "-" & ClassCount As Integer
Is there any way to make something like that work, or is there a better way to do it?
I'm a bit sketchy on classes, and I really should start looking at them more as they're very powerful - this link will give you more info: http://www.cpearson.com/excel/classes.aspx
Expanding on Jasons comments this is one way of building the class, and I'm sure there's a much better way of doing it:
Add a Class Module to your project and name the module cls_Quote.
Add this code to the class module:
Option Explicit
Private sQuote As String
Private lQuantity As Long
Private lAnotherValue As Long
Public Property Let Quote(Value As String)
sQuote = Value
End Property
Public Property Get Quote() As String
Quote = sQuote
End Property
Public Property Let Quantity(Value As Long)
lQuantity = Value
End Property
Public Property Get Quantity() As Long
Quantity = lQuantity
End Property
Public Property Let AnotherValue(Value As Long)
lAnotherValue = Value
End Property
In a normal module add this code:
Option Explicit
Private MyQuotes As Collection
Public Sub Test()
Dim MyNewQuote As cls_Quote
Dim x As Long
Dim vIQuote As Variant
Dim FinalSum As Long
Set MyQuotes = New Collection
For x = 1 To 10
Set MyNewQuote = New cls_Quote
With MyNewQuote
.Quantity = x
.Quote = "Pipes"
.AnotherValue = x * 5
End With
MyQuotes.Add MyNewQuote
Next x
For Each vIQuote In MyQuotes
If vIQuote.Quote = "Pipes" Then
FinalSum = FinalSum + vIQuote.Quantity
End If
Next vIQuote
MsgBox "Total sum of Pipes is: " & FinalSum
End Sub
Note: In the For x loop I'm creating a new instance of the class each time.
Now just waiting for someone with more class programming experience to show a much better way of doing it. :)

Converting all elements of an array from string to double at once VBA [closed]

Closed. This question needs to be more focused. It is not currently accepting answers.
Closed 4 years ago.
Locked. This question and its answers are locked because the question is off-topic but has historical significance. It is not currently accepting new answers or interactions.
Is there a way to convert all elements of an array from string to double without having to convert each element one by one. I want to avoid to use a loop if possible. I'd like to know that for VBA not VB.Net
In some scenarios you could use CopyMem to move data between arrays of different types. (For instance Strings to Integer Arrays.) But this won't work with String and Doubles as equivilant values are stored differently at a byte level. So a String Binary "1" is not the same set of 1s and 0s as Double Binary and vice versa.
Generally speaking you will need to do it with a conversion function:
Public Sub Test()
Const clUprBnd As Long = 9&
Dim asTest(clUprBnd) As String
Dim adTest() As Double
Dim lIndx As Long
For lIndx = 0& To clUprBnd
asTest(lIndx) = CStr(lIndx)
Next
adTest = StringArrayToDoubleArray(asTest)
MsgBox adTest(5)
End Sub
Private Function StringArrayToDoubleArray(ByRef values() As String) As Double()
Dim lIndx As Long, lLwrBnd As Long, lUprBnd As Long
Dim adRtnVals() As Double
lLwrBnd = LBound(values)
lUprBnd = UBound(values)
ReDim adRtnVals(lLwrBnd To lUprBnd) As Double
For lIndx = lLwrBnd To lUprBnd
adRtnVals(lIndx) = CDbl(values(lIndx))
Next
StringArrayToDoubleArray = adRtnVals
End Function
I'm trying to think conceptually how it is possible, at any layer of abstraction, to "do something" on each (the keyword here is each) item in an array without processing it one at a time.
At the lowest levels of abstraction concerning a single CPU, each item in an array is always going to be processed one at a time. The CPU can't take a collection and magically transform each element without iterating through each item in the collection. The words iteration (and consequently, loop) and each enjoy each other's company very much.
Now, is it possible, at higher layers of abstraction, to present to the programmer a method/function/procedure that looks like it's acting on an entire collection? Yes, it's very possible. LINQ (in .NET) does this a lot. However, all LINQ does is provide a way for a programmer to act on each item in a collection using only one statement.
Even if VBA had a way to convert the elements in an array from one type to another (which I don't believe it does), at some level of abstraction, the program will have to iterate through each item in the list to perform the change.
That being said, I think you're stuck doing a loop. The best thing you could do is wrap this functionality within a Function. Here's a sample function with some test code:
Function ConvertArray(arrStr() As String) As Double()
Dim strS As String
Dim intL As Integer
Dim intU As Integer
Dim intCounter As Integer
Dim intLen As Integer
Dim arrDbl() As Double
intL = LBound(arrStr)
intU = UBound(arrStr)
ReDim arrDbl(intL To intU)
intCounter = intL
Do While intCounter <= UBound(arrDbl)
arrDbl(intCounter) = CDbl(arrStr(intCounter))
intCounter = intCounter + 1
Loop
ConvertArray = arrDbl
End Function
Sub Test()
Dim strS(0 To 2) As String
Dim dblD() As Double
Dim dbl As Variant
strS(0) = "15.5"
strS(1) = "12"
strS(2) = "4.543"
dblD = ConvertArray(strS)
For Each dbl In dblD
Debug.Print dbl
Next dbl
End Sub
The answer to that exact question is "no". There is no built in VBA operator that works on typed arrays like that.
However, you can have an array of variants, and that can contain elements that are strings or doubles (or other things of course). So if your concern is being able to pass arrays around or use individual elements without having to do explicit conversions, you can do something like:
Public Sub passesStuff()
Call expectsNumericStuff(Array("1", "2", "3"))
Call expectsNumericStuff(Array(1, 2, 3))
End Sub
Public Sub expectsNumericStuff(arr)
Debug.Assert IsArray(arr)
Debug.Assert IsNumeric(arr(1))
Debug.Print arr(1) * 42
End Sub
Obviously all of the advantages and disadvantages of variants then apply, and should be kept in mind.

Hidden features of VBA

Locked. This question and its answers are locked because the question is off-topic but has historical significance. It is not currently accepting new answers or interactions.
Which features of the VBA language are either poorly documented, or simply not often used?
This trick only works in Access VBA, Excel and others won't allow it. But you can make a Standard Module hidden from the object browser by prefixing the Module name with an underscore. The module will then only be visible if you change the object browser to show hidden objects.
This trick works with Enums in all vb6 based version of VBA. You can create a hidden member of an Enum by encasing it's name in brackets, then prefixing it with an underscore. Example:
Public Enum MyEnum
meDefault = 0
meThing1 = 1
meThing2 = 2
meThing3 = 3
[_Min] = meDefault
[_Max] = meThing3
End Enum
Public Function IsValidOption(ByVal myOption As MyEnum) As Boolean
If myOption >= MyEnum.[_Min] Then IsValidOption myOption <= MyEnum.[_Max]
End Function
In Excel-VBA you can reference cells by enclosing them in brackets, the brackets also function as an evaluate command allowing you to evaluate formula syntax:
Public Sub Example()
[A1] = "Foo"
MsgBox [VLOOKUP(A1,A1,1,0)]
End Sub
Also you can pass around raw data without using MemCopy (RtlMoveMemory) by combining LSet with User Defined Types of the same size:
Public Sub Example()
Dim b() As Byte
b = LongToByteArray(8675309)
MsgBox b(1)
End Sub
Private Function LongToByteArray(ByVal value As Long) As Byte()
Dim tl As TypedLong
Dim bl As ByteLong
tl.value = value
LSet bl = tl
LongToByteArray = bl.value
End Function
Octal & Hex Literals are actually unsigned types, these will both output -32768:
Public Sub Example()
Debug.Print &H8000
Debug.Print &O100000
End Sub
As mentioned, passing a variable inside parenthesis causes it to be passed ByVal:
Sub PredictTheOutput()
Dim i&, j&, k&
i = 10: j = i: k = i
MySub (i)
MySub j
MySub k + 20
MsgBox Join(Array(i, j, k), vbNewLine), vbQuestion, "Did You Get It Right?"
End Sub
Public Sub MySub(ByRef foo As Long)
foo = 5
End Sub
You can assign a string directly into a byte array and vice-versa:
Public Sub Example()
Dim myString As String
Dim myBytArr() As Byte
myBytArr = "I am a string."
myString = myBytArr
MsgBox myString
End Sub
"Mid" is also an operator. Using it you overwrite specific portions of strings without VBA's notoriously slow string concatenation:
Public Sub Example1()
''// This takes about 47% of time Example2 does:
Dim myString As String
myString = "I liek pie."
Mid(myString, 5, 2) = "ke"
Mid(myString, 11, 1) = "!"
MsgBox myString
End Sub
Public Sub Example2()
Dim myString As String
myString = "I liek pie."
myString = "I li" & "ke" & " pie" & "!"
MsgBox myString
End Sub
There is an important but almost always missed feature of the Mid() statement. That is where Mid() appears on the left hand side of an assignment as opposed to the Mid() function that appears in the right hand side or in an expression.
The rule is that if the if the target string is not a string literal, and this is the only reference to the target string, and the length of segment being inserted matches the length of the segment being replaced, then the string will be treated as mutable for the operation.
What does that mean? It means that if your building up a large report or a huge list of strings into a single string value, then exploiting this will make your string processing much faster.
Here is a simple class that benefits from this. It gives your VBA the same StringBuilder capability that .Net has.
' Class: StringBuilder
Option Explicit
Private Const initialLength As Long = 32
Private totalLength As Long ' Length of the buffer
Private curLength As Long ' Length of the string value within the buffer
Private buffer As String ' The buffer
Private Sub Class_Initialize()
' We set the buffer up to it's initial size and the string value ""
totalLength = initialLength
buffer = Space(totalLength)
curLength = 0
End Sub
Public Sub Append(Text As String)
Dim incLen As Long ' The length that the value will be increased by
Dim newLen As Long ' The length of the value after being appended
incLen = Len(Text)
newLen = curLength + incLen
' Will the new value fit in the remaining free space within the current buffer
If newLen <= totalLength Then
' Buffer has room so just insert the new value
Mid(buffer, curLength + 1, incLen) = Text
Else
' Buffer does not have enough room so
' first calculate the new buffer size by doubling until its big enough
' then build the new buffer
While totalLength < newLen
totalLength = totalLength + totalLength
Wend
buffer = Left(buffer, curLength) & Text & Space(totalLength - newLen)
End If
curLength = newLen
End Sub
Public Property Get Length() As Integer
Length = curLength
End Property
Public Property Get Text() As String
Text = Left(buffer, curLength)
End Property
Public Sub Clear()
totalLength = initialLength
buffer = Space(totalLength)
curLength = 0
End Sub
And here is an example on how to use it:
Dim i As Long
Dim sb As StringBuilder
Dim result As String
Set sb = New StringBuilder
For i = 1 to 100000
sb.Append CStr( i)
Next i
result = sb.Text
VBA itself seems to be a hidden feature. Folks I know who've used Office products for years have no idea it's even a part of the suite.
I've posted this on multiple questions here, but the Object Browser is my secret weapon. If I need to ninja code something real quick, but am not familiar with the dll's, Object Browser saves my life. It makes it much easier to learn the class structures than MSDN.
The Locals Window is great for debugging as well. Put a pause in your code and it will show you all the variables, their names, and their current values and types within the current namespace.
And who could forget our good friend Immediate Window? Not only is it great for Debug.Print standard output, but you can enter in commands into it as well. Need to know what VariableX is?
?VariableX
Need to know what color that cell is?
?Application.ActiveCell.Interior.Color
In fact all those windows are great tools to be productive with VBA.
It's not a feature, but a thing I have seen wrong so many times in VBA (and VB6): Parenthesis added on method calls where it will change semantics:
Sub Foo()
Dim str As String
str = "Hello"
Bar (str)
Debug.Print str 'prints "Hello" because str is evaluated and a copy is passed
Bar str 'or Call Bar(str)
Debug.Print str 'prints "Hello World"
End Sub
Sub Bar(ByRef param As String)
param = param + " World"
End Sub
Hidden Features
Although it is "Basic", you can use OOP - classes and objects
You can make API calls
Possibly the least documented features in VBA are those you can only expose by selecting "Show Hidden Members" on the VBA Object Browser. Hidden members are those functions that are in VBA, but are unsupported. You can use them, but microsoft might eliminate them at any time. None of them has any documentation provided, but you can find some on the web. Possibly the most talked about of these hidden features provides access to pointers in VBA. For a decent writeup, check out; Not So Lightweight - Shlwapi.dll
Documented, but perhaps more obscure (in excel anyways) is using ExecuteExcel4Macro to access a hidden global namespace that belongs to the entire Excel application instance as opposed to a specific workbook.
You can implement interfaces with the Implements keyword.
Dictionaries. VBA is practically worthless without them!
Reference the Microsoft Scripting Runtime, use Scripting.Dictionary for any sufficiently complicated task, and live happily ever after.
The Scripting Runtime also gives you the FileSystemObject, which also comes highly recommended.
Start here, then dig around a bit...
http://msdn.microsoft.com/en-us/library/aa164509%28office.10%29.aspx
Typing VBA. will bring up an intellisense listing of all the built-in functions and constants.
With a little work, you can iterate over custom collections like this:
' Write some text in Word first.'
Sub test()
Dim c As New clsMyCollection
c.AddItems ActiveDocument.Characters(1), _
ActiveDocument.Characters(2), _
ActiveDocument.Characters(3), _
ActiveDocument.Characters(4)
Dim el As Range
For Each el In c
Debug.Print el.Text
Next
Set c = Nothing
End Sub
Your custom collection code (in a class called clsMyCollection):
Option Explicit
Dim m_myCollection As Collection
Public Property Get NewEnum() As IUnknown
' This property allows you to enumerate
' this collection with the For...Each syntax
' Put the following line in the exported module
' file (.cls)!'
'Attribute NewEnum.VB_UserMemId = -4
Set NewEnum = m_myCollection.[_NewEnum]
End Property
Public Sub AddItems(ParamArray items() As Variant)
Dim i As Variant
On Error Resume Next
For Each i In items
m_myCollection.Add i
Next
On Error GoTo 0
End Sub
Private Sub Class_Initialize()
Set m_myCollection = New Collection
End Sub
Save 4 whole keystrokes by typing debug.? xxx instead of debug.print xxx.
Crash it by adding: enum foo: me=0: end enum to the top of a module containing any other code.
Support for localized versions, which (at least in the previous century) supported expressions using localized values. Like Pravda for True and FaƂszywy (not too sure, but at least it did have the funny L) for False in Polish... Actually the English version would be able to read macros in any language, and convert on the fly. Other localized versions would not handle that though.
FAIL.
The VBE (Visual Basic Extensibility) object model is a lesser known and/or under-utilized feature. It lets you write VBA code to manipulate VBA code, modules and projects. I once wrote an Excel project that would assemble other Excel projects from a group of module files.
The object model also works from VBScript and HTAs. I wrote an HTA at one time to help me keep track of a large number of Word, Excel and Access projects. Many of the projects would use common code modules, and it was easy for modules to "grow" in one system and then need to be migrated to other systems. My HTA would allow me to export all modules in a project, compare them to versions in a common folder and merge updated routines (using BeyondCompare), then reimport the updated modules.
The VBE object model works slightly differently between Word, Excel and Access, and unfortunately doesn't work with Outlook at all, but still provides a great capability for managing code.
IsDate("13.50") returns True but IsDate("12.25.2010") returns False
This is because IsDate could be more precisely named IsDateTime. And because the period (.) is treated as a time separator and not a date separator. See here for a full explanation.
VBA supports bitwise operators for comparing the binary digits (bits) of two values. For example, the expression 4 And 7 evaluates the bit values of 4 (0100) and 7 (0111) and returns 4 (the bit that is on in both numbers.) Similarly the expression 4 Or 8 evaluates the bit values in 4 (0100) and 8 (1000) and returns 12 (1100), i.e. the bits where either one is true.
Unfortunately, the bitwise operators have the same names at the logical comparison operators: And, Eqv, Imp, Not, Or, and Xor. This can lead to ambiguities, and even contradictory results.
As an example, open the Immediate Window (Ctrl+G) and enter:
? (2 And 4)
This returns zero, since there are no bits in common between 2 (0010) and 4 (0100).
Deftype Statements
This feature exists presumably for backwards-compatibility. Or to write hopelessly obfuscated spaghetti code. Your pick.