Reference an array declared in a different userform - arrays

I'm not an experienced VBA programmer but I've been trying to create an Excel Spreadsheet that is able to manage a basketball team.
In it I've got a primary userform where I have declared an array, 'selectedPlayers'.
This primary userform has a for loop that starts up the secondary userform 'i' times.
I have not been able to access the primary userform's 'i' and 'selectedPlayers' from the secondary one.
I've been able to find a workaround the 'i' by creating a non-visible textbox in the first userform, that I'm able to reference from the second one.
I've tried declaring both of them as public, but yet I'm not able to call upon it from the second userform.
part of the code for the first userform:
i = 0
Do While Not i = Int(txtNumberPlayers)
frmGameDataSecondary.Show
i = i + 1
Loop
second userform:
Private Sub cmdDone_Click()
frmGameData.selectedPlayers(frmGameData.i) = lbxPlayer.Value
Unload Me
End Sub
Private Sub UserForm_Initialize()
With Me.lbxPlayer
For Each LR In LO.ListRows
exitSequence = False
For k = 1 To Int(frmGameData.txtNumberPlayers)
If frmGameData.selectedPlayers(k) = blablabla.Value Then
exitSequence = True
End If
Next k
If !exitSequence Then
.AddItem blablabla.Value
End If
Next LR
End With
End Sub

The main problem is that array contents are cleared after the sub is finished.
I was also messing around with this idea and there is a really good thread I started with tons of great information from various awesome people
Calling an Array Upon User Form Terminate/Close VBA

Forms in VBA are Objects, and can be treated like any other Class module. This means that you can add properties to them. If you need to pass information back from a form, all you need to do is grab a reference to it, then Hide it instead of Unload it. Treat it like a dialog and let the calling code handle it's create and destruction (I'm assuming from your code that it is modal).
Something like this:
In the first UserForm:
For i = 0 To 1
Dim second As frmGameDataSecondary
Set second = New frmGameDataSecondary
second.Show
'Execution suspends until the second form is dismissed.
selectedPlayers(i) = second.Player
Unload second
Next i
In the second UserForm:
Private mPlayer As String
'This is where your returned information goes.
Public Property Get Player() As String
Player = mPlayer
End Property
Private Sub cmdDone_Click()
mPlayer = lbxPlayer.Value
'Control passes back to the caller, but the object still exists.
Me.Hide
End Sub

You can declare properties inside of parent form which will manipulate the array from outside. The child form needs to have a reference to parent so it can call this properties. HTH
Parent form
Option Explicit
' I have not been able to access the primary userform's
' 'i' and 'selectedPlayers' from the secondary one
Private selectedPlayers As Variant
Public Function GetMyArrayValue(index) As Variant
GetMyArrayValue = selectedPlayers(index)
End Function
Public Sub SetMyArrayValue(index, newValue)
selectedPlayers(index) = newValue
End Sub
Private Sub UserForm_Click()
Dim i
i = 0
Do While Not i = Int(txtNumberPlayers)
With New secondaryUserForm
Set .ParentForm = Me
.SetIndex = i
.Show
End With
i = i + 1
Loop
End Sub
Private Sub UserForm_Initialize()
selectedPlayers = Array("A", "B", "C")
End Sub
Child form
Option Explicit
Private m_parent As primaryUserForm
Private m_index As Integer
Public Property Let SetIndex(ByVal vNewValue As Integer)
m_index = vNewValue
End Property
Public Property Set ParentForm(ByVal vNewValue As UserForm)
Set m_parent = vNewValue
End Property
Private Sub cmdDone_Click()
' frmGameData.selectedPlayers(frmGameData.i) = lbxPlayer.Value
m_parent.SetMyArrayValue m_index, "lbxPlayer.Value"
Unload Me
End Sub

Related

(VB.NET) display the lower half of a textfile to a listbox

I have to make a application that organizes a list of runners and their teams. In the following text file, I have to remove the top half of the text file (the top half being the listed teams) and display only the bottom half (the runners)in a listbox item.
The Text file:
# School [School Code|School Name|Coach F-Name|Coach L-Name|AD F-Name|AD L Name]
WSHS|Worcester South High School|Glenn|Clauss|Bret|Zane
WDHS|Worcester Dorehty High School|Ellsworth|Quackenbush|Bert|Coco
WBCHS|Worcester Burncoat High School|Gail|Cain|Kevin|Kane
QRHS|Quabbin Regional High School|Bob|Desilets|Seth|Desilets
GHS|Gardner High School|Jack|Smith|George|Fanning
NBHS|North Brookfield High School|Hughe|Fitch|Richard|Carey
WHS|Winchendon High School|Bill|Nice|Sam|Adams
AUBHS|Auburn High School|Katie|Right|Alice|Wonderland
OXHS|Oxford High School|Mary|Cousin|Frank|Daughter
# Roster [Bib #|School Code|Runner's F-Name|Runner's L-Name]
101|WSHS|Sanora|Hibshman
102|WSHS|Bridgette|Moffitt
103|WSHS|Karine|Chunn
104|WSHS|Shanita|Wind
105|WSHS|Fernanda|Parsell
106|WSHS|Albertha|Baringer
107|WSHS|Carlee|Sowards
108|WDHS|Maisha|Kleis
109|WDHS|Lezlie|Berson
110|WDHS|Deane|Rocheleau
111|WDHS|Hang|Hodapp
112|WDHS|Zola|Dorrough
113|WDHS|Shalon|Mcmonigle
I have some code that reads each row from the text file as an array and uses boolean variables to determine where to end the text file. This worked with displaying only the teams, which I've managed to do. But I now need to do the opposite and display only the players, and I'm a bit stumped.
My Code:
Private Sub btnLoadTeams_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLoadTeam.Click
' This routine loads the lstTeam box from an ASCII .txt file
' # School [School Code | Name | Coach F-Name| Coach L-Name | AD F-Name | AD L-Name]
Dim strRow As String
Dim bolFoundCode As Boolean = False
Dim bolEndCode As Boolean = False
Dim bolFoundDup As Boolean = False
Dim intPosition As Integer
Dim intPosition2 As Integer
Dim strTeamCodeIn As String
Dim textIn As New StreamReader( _
New FileStream(txtFilePath.Text, FileMode.OpenOrCreate, FileAccess.Read))
' Clear Team listbox
lstTeam.Items.Clear()
btnDeleteRunner.Enabled = True
Do While textIn.Peek <> -1 And Not bolEndCode
Me.Refresh()
strRow = textIn.ReadLine.Trim
If Not bolFoundCode Then
If "# SCHOOL " = UCase(Mid(strRow, 1, 9)) Then
bolFoundCode = True
End If
Else
If Mid(strRow, 1, 2) <> "# " Then
For Each item As String In lstTeam.Items
intPosition = InStr(1, strRow, "|")
strTeamCodeIn = Mid(strRow, 1, intPosition - 1)
intPosition2 = InStr(1, item, strTeamCodeIn)
If intPosition2 > 0 Then
bolFoundDup = True
MsgBox("Found Duplicate School Code: " & strTeamCodeIn)
End If
Else
bolEndCode = True
Next
If Not bolFoundDup Then
lstTeam.Items.Add(strRow)
Else
lstTeam.Items.Add("DUPLICATE School Code: " & strRow)
lstTeam.Items.Add("Please correct input file and reload teams")
bolEndCode = True
End If
End If
End If
Loop
End Sub
Ive put bolEndCode = True in between the part that reads the mid section of the text file, but all Ive managed to display is the following in the listbox:
# Roster [Bib #|School Code|Runner's F-Name|Runner's L-Name]
Any help or hints on how I would display just the runners to my "lstPlayers" listbox would be greatly appreciated. I'm a beginner programmer and We've only just started learning about reading and writing arrays in my .NET class.
First I made 2 classes, one Runner and one School. These have the properties available in the text file. As part of the class I added a function that overrides .ToString. This is for he list boxes that call .ToString for display.
Next I made a function that reads all the data in the file. This is very simple with the File.ReadLines method.
Then I created 2 variables List(Of T) T stands for Type. Ours Types are Runner and School. I used List(Of T) instead of arrays because I don't have to worry about what the size of the list is. No ReDim Preserve, just keep adding items. The FillList method adds the data to the lists. First I had to find where the schools ended and the runners started. I used the Array.FindIndex method which is a bit different because the second parameter is a predicate. Check it out a bit. Now we know the indexes of the lines we want to use for each list and use a For...Next loop. In each loop an instance of the class is created and the properties set. Finally the new object is added to the the list.
Finally we fill the list boxes with a simple .AddRange and the lists.ToArray. Note that we are adding the entire object, properties and all. The neat thing is we can access the properties from the listbox items. Check out the SelectedIndexChanged event. You can do the same thing with the Runner list box.
Sorry, I couldn't just work with your code. I have all but forgotten the old vb6 methods. InStr, Mid etc. It is better when you can to use .net methods. It makes your code more portable when the boss says "Rewrite the whole application in C#"
Public Class Runner
Public Property BibNum As Integer
Public Property SchoolCode As String
Public Property FirstName As String
Public Property LastName As String
Public Overrides Function ToString() As String
'The listbox will call .ToString when we add a Runner object to determin what to display
Return $"{FirstName} {LastName}" 'or $"{LastName}, {FirstName}"
End Function
End Class
Public Class School
Public Property Code As String
Public Property Name As String
Public Property CoachFName As String
Public Property CoachLName As String
Public Property ADFName As String
Public Property ADLName As String
'The listbox will call .ToString when we add a School object to determin what to display
Public Overrides Function ToString() As String
Return Name
End Function
End Class
Private Runners As New List(Of Runner)
Private Schools As New List(Of School)
Private Function ReadData(path As String) As String()
Dim lines = File.ReadLines(path).ToArray
Return lines
End Function
Private Sub FillLists(data As String())
Dim location = Array.FindIndex(data, AddressOf FindRosterLine)
'The first line is the title so we don't start at zero
For index = 1 To location - 1
Dim SplitData = data(index).Split("|"c)
Dim Schl As New School
Schl.Code = SplitData(0)
Schl.Name = SplitData(1)
Schl.CoachFName = SplitData(2)
Schl.CoachLName = SplitData(3)
Schl.ADFName = SplitData(4)
Schl.ADLName = SplitData(5)
Schools.Add(Schl)
Next
For index = location + 1 To data.GetUpperBound(0)
Dim SplitData = data(index).Split("|"c)
Dim Run As New Runner
Run.BibNum = CInt(SplitData(0))
Run.SchoolCode = SplitData(1)
Run.FirstName = SplitData(2)
Run.LastName = SplitData(3)
Runners.Add(Run)
Next
End Sub
Private Function FindRosterLine(s As String) As Boolean
If s.Trim.StartsWith("# Roster") Then
Return True
Else
Return False
End If
End Function
Private Sub FillListBoxes()
Dim arrRunners As Runner() = Runners.ToArray
Dim arrSchools As School() = Schools.ToArray
ListBox1.Items.AddRange(arrSchools)
ListBox2.Items.AddRange(arrRunners)
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim arrRunner = ReadData("Runners.txt")
FillLists(arrRunner)
FillListBoxes()
End Sub
Private Sub ListBox1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ListBox1.SelectedIndexChanged
Dim Schl = DirectCast(ListBox1.SelectedItem, School)
TextBox1.Text = Schl.CoachLName
TextBox2.Text = Schl.Code
End Sub

access an array in a different sub

I have a sub that creates an array and fills it with data, but I would like to use the same array (with the data recorded from previous sub) in a different sub/function. Is there a way to achieve that.
I'm quite new to VBA, so maybe I'm missing something obvious here.
Thanks in advance.
EDIT:
'//FIRST CODE
Dim MyResults() As String
'
'
'Fill MyResults() with data
'
'
Call ComboToText
'//SECOND CODE
Private Sub ComboToText()
'// If there is more than one item in MyResults() use combo box. For one item use Textbox.
Dim n As Long
If UBound(MyResults) > 1 Then
txtPCB.Visible = False
With cmbPCB
.Visible = True
For n = LBound(MyResults) To UBound(MyResults)
.AddItem MyResults(n)
Next n
.Style = fmStyleDropDownCombo
End With
Else
txtPCB.Text = MyResults(1)
End With
End Sub
Whenever I'm trying to run, VBA insists on declaration of MyResults() in second code too. If I declare it again, wouldn't I lose the data that's already in it?
As YowE3K says, you can pass the array as an argument to another sub:
Dim MyResults() As String
'Fill MyResults() with data
Call ComboToText(MyResults)
'//SECOND CODE
Private Sub ComboToText(MyResults() As String)
...
It's fine to use the same name in both Subs, as I did, but you can also use a different name in the second Sub.

VBA Dynamic array : change size and use of Get Let Property

The problem: I would like to create a dynamic array that change size when an event occurs (Event Calculate), by preserving its content and extending by one its size. Let's say I want to do this for a vector of double (and also a date type). The data is updating in a specific cell.
My understanding: I am coding in the Event "Calculate of Excel". I cannot use "Public", I have to declare the array as private and then use Get and Let Property... But, how can I use Redim Preserve in this case ? Also, I think I am probably missing some points on how it has to be used: Here s a sample of the code I wrote:
Name of the Classe: "Class1"
Code of the class:
Code:
Option Explicit
Private IntradayValueSerie1() As Double 'Dynamic vector which will contain Y1 Values
Public Counter As Long
Public Property Let vIntradayValueSerie1(ByVal Counter_Value As Long)
IntradayValueSerie1(Counter_Value) = Sheets("Sheet1").Range("C5")
End Property
Public Property Get vIntradayValueSerie1(ByVal Counter_Value As Long) As Variant
vIntradayValueSerie1(Counterr) = IntradayValueSerie1
End Property
So I want "Let" To attribute the new value of my extended array
I want "Get" to return the array (extended and updated)
Remark: Counter will be updated and increase at then end of the in the section Event "Worksheet.Calculate"
Test code (HAS TO BE in the section Event "Worksheet.Calculate")
Code:
counter = 1
Dim Serie1 As New Class1
Serie1.IntradayValueSerie1(Counter) = ??? I don't know how to use the property to initialize the vector
counter = counter +1
ReDim Preserve IntradayValueSerie1(Counter)
Also, As I want to return an array, do I have to set Variant for the Get property ? As you can see, some points make me confused, either on the use and the structure.
Thank you for you time !
edited to match the following assumptions
a Sub in any of your modules initializes and uses a variable of Class1 type
I'll call it after Sub ExploitClass1(), but you can rename it as you like
that Sub writes into any cell of the relavant worksheet whose calculate event you want to use to update the dynamic array property of your variable of Class1 type
I'll assume that relevant worksheet is named after "CalculateClass": you can rename it as you like but be sure to fill its code pane with what you'll find in "your relevant worksheet code pane" section of this answer
then proceed like follows:
your Class1 code pane
Option Explicit
Private IntradayValueSerie1() As Double 'Dynamic array which will contain Y1 Values
Private counter As Long '<-- counter to track the size of the dynamic array
Public Sub WriteValue(ByVal Value As Variant) '<-- class method to write a value in the last dynamic array slot
IntradayValueSerie1(counter) = Value
Extend
End Sub
Private Sub Extend() '<-- class method to extend dynamic array size by one
counter = counter + 1 '<-- update the dynamic array size counter by one
ReDim Preserve IntradayValueSerie1(1 To counter) '<-- increase the dynamic array size
End Sub
Private Sub Class_Initialize()
counter = 1
ReDim IntradayValueSerie1(1 To counter) '<-- at class instantiating, initialize the dynamic array
End Sub
'-----------------------------------------------
' added methods to "query" some dynamic array related values
'-----------------------------------------------
Public Function GetCounter() As Long '<-- class method to retrive the current counter (i.e. the dynamic array size) value
GetCounter = counter '<-- return counter
End Function
Public Function GetPenultimateArrayValue() As Variant '<-- class method to retrive the current counter (i.e. the dynamic array size) value
GetPenultimateArrayValue = IntradayValueSerie1(counter - 1) '<-- return dynamic array one before second to last element
End Function
your Sub
Option Explicit
Public Serie1 As Class1 '<-- declare a Public variable of type Class1
Sub ExploitClass1()
Set Serie1 = New Class1 '<-- instantiate a new public object of type Class1
Worksheets("CalculateClass").Range("A1") = 1 ' make something that triggers calulate event in the relevant worksheet: in this case I had cell "A2" of that worksheet with a formula `= A1+1`
MsgBox Serie1.GetPenultimateArrayValue & " - " & Serie1.GetCounter 'show your Class1 dynamic array has been updated exploiting those "querying" methods we added at the bottom of your class
End Sub
your relevant worksheet code pane
it'll use the Public object of Class1 type we declared and initialized in ExploitClass1() sub
Option Explicit
Private Sub Worksheet_Calculate()
Serie1.WriteValue Worksheets("Sheet01").Range("C5").Value '<-- this will write the passed value to your class dynamic array last slot
End Sub

vba (catia) destroying objects from array

i have a question about destroying object from standard and custom classes through array, here is example:
dim class1 As cClass1
dim class2 As cClass2
dim class3 As cClass3
....
Set class1 = New cClass1
Set class2 = New cClass2
Set class3 = New cClass3
....
after using them i want to destroy them at the end to release them from memory, but i want to avoid usage of
Set class1 = Nothing
Set class2 = Nothing
.... 'and so on
i want to destroy them with:
CRLS Array(class1, class2, class3, "and so on")
and here is sub that might do that:
Private Sub CLRS(ByRef arr As Variant)
Dim i As Integer
For i = 0 To UBound(arr)
If Not arr(i) Is Nothing Then
Set arr(i) = Nothing
Debug.Print "Deleted" 'it will throw "Deleted" but it will not delete element itself
Else
Debug.Print "not deleted" 'just to see status of element
End If
Next
Erase arr
End Sub
but unfortunately, if i check if "destroyed" elements are really free, answer is not, only copy of selected elements was set to nothing. objects are passed to array just as ByVal.
VBA destroys objects by using reference counters. When the object reference count is zero, the object gets destroyed. Say for your class1 variable you increase the counter by one by setting it in:
Set class1 = New cClass1
Then you pass the object to the array.
Array(class1, class2, class3, "and so on")
The object reference count becomes two because now the array has its own reference. Then you set the array reference to nothing and the count is one because class1 still has the reference.

VBA Arrays - test for empty, create new, return element

Please would someone who understands VBA Arrays (Access 2003) help me with the following code.
The idea is that ClassA holds a dynamic array of ClassB instances. The dynamic array starts empty. As callers call ClassA.NewB() then a new instance of ClassB is created, added to the array, and returned to the caller.
The problem is that I can't return the new instance of ClassB to the caller, but get "Runtime error 91: Object variable or With block variable not set"
Also, a little WTF occurs where UBound() fails but wrapping the exact same call in another function works!?!? (Hence MyUbound() )
I'm from a C++ background and this VBA stuff is all a bit strange to me!
Thanks for any help!
Main code:
Dim a As clsClassA
Dim b As clsClassB
Set a = New clsClassA
a.Init
Set b = a.NewB(0)
clsClassA:
Option Compare Database
Private a() As clsClassB
Public Sub Init()
Erase a
End Sub
Public Function NewB(i As Integer) As Variant
'If (UBound(a, 1) < i) Then ' FAILS: Runtime error 9: Subscript out of range
If (MyUBound(a) < i) Then ' WORKS: Returns -1
ReDim Preserve a(0 To i)
End If
NewB = a(i) ' FAILS: Runtime error 91: Object variable or With block variable not set
End Function
Private Function MyUBound(a As Variant) As Long
MyUBound = UBound(a, 1)
End Function
clsClassB:
Option Compare Database
' This is just a stub class for demonstration purposes
Public data As Integer
Your approach stores a collection of ClassB instances in an array. For each instance you add, you must first ReDim the array. ReDim is an expensive operation, and will become even more expensive as the number of array members grows. That wouldn't be much of an issue if the array only ever held a single ClassB instance. OTOH, if you don't intend more than one ClassB instance, what is the point of storing it in an array?
It makes more sense to me to store the collection of instances in a VBA Collection. Collections are fast for this, and aren't subject to the dramatic slow downs you will encounter with an array as the number of items grows.
Here is a Collection approach for clsClassA.
Option Compare Database
Option Explicit
Private mcolA As Collection
Private Sub Class_Initialize()
Set mcolA = New Collection
End Sub
Private Sub Class_Terminate()
Set mcolA = Nothing
End Sub
Public Function NewB(ByVal i As Integer) As Object
Dim objB As clsClassB
If i > mcolA.Count Then
Set objB = New clsClassB
mcolA.Add objB
Else
Set objB = Nothing
End If
Set NewB = objB
Set objB = Nothing
End Function
The only change I made to clsClassB was to add Option Explicit.
This procedure uses the class.
Public Sub test_ClassA_NewB()
Dim a As clsClassA
Dim b As clsClassB
Set a = New clsClassA
Set b = a.NewB(1) '' Collections are one-based instead of zero-based
Debug.Print TypeName(b) ' prints clsClassB
Debug.Print b.data '' prints 0
b.data = 27
Debug.Print b.data '' prints 27
Set b = Nothing
Set a = Nothing
End Sub
Try this:
Public Function NewB(i As Integer) As Variant
'If (UBound(a, 1) < i) Then ' FAILS: Runtime error 9: Subscript out of range
If (MyUBound(a) < i) Then ' WORKS: Returns -1
ReDim Preserve a(0 To i)
End If
Set a(i) = New clsClassB
Set NewB = a(i)
End Function
You need to set a(i) to a new instance of the class (or it will simply be null), you also need to use Set as you're working with an object...
I'd perhaps also suggest changing the return type of NewB to clsClassB rather than Variant.
You could also do
Public Sub Init()
ReDim a(0 To 0)
Set a(0) = New Class2
End Sub
to remove the need for the special UBound function.
The UBound function throws this error when you try to use it on an array with no dimension (which is your case since you did an Erase on the array). You should have an error handler in your function to treat this case.
I use a special function to check if the array is empty, but you can just use parts of it for error handling.
Public Function IsArrayEmpty(ByRef vArray As Variant) As Boolean
Dim i As Long
On Error Resume Next
IsArrayEmpty = False
i = UBound(vArray) > 0
If Err.Number > 0 Then IsArrayEmpty = True
On Error GoTo 0
End Function
Also, if you still want to do an array then you could
redim preserve MyArray(lbound(MyArray) to ubound(MyArray)*2)
which will lesson the amount of times it redimensions, you would need a counter to redimension it at the very end.
Also, Dictionaries are supposed to be really fast (and more versatile than collections), they're like collections and you need to add a reference to Microsoft Scripting Runtime if you want to do dictionaries.

Resources