I'm using a loop to fill a collection. There are a few properties for each item of the collection, but some of these properties are optional. The user is prompted to choose which properties will be copied to the collection. Is it possible to omit the code for the optional properties if the user has chosen to ignore them?
Sub fillcoll()
Dim coll as Collection
Set coll = New Collection
Dim NewItem as Class1
For each r in Selection.Rows
Set NewItem = New Class1
If Userform1.Checkbox1.Value = True then
NewItem.Property1 = somearray1(r.Row)
End If
If Userform1.Checkbox2.Value = True then
NewItem.Property2 = somearray2(r.Row)
End If
If Userform1.Checkbox3.Value = True then
NewItem.Property3 = somearray3(r.Row)
End If
Next r
End Sub
With this code, the Checkboxes' values are read at each iteration. I fear that this may slow down the program's execution unnecessarily. The checkboxes could be read once and the loop's contents would adapt to the checkboxes' values. Is this possible?
Thanks in advance.
Read the checkboxes at the beginning,out of the loop, and assign their values to three booleans or an array of booleans. then you just read from the boolean variables every time.
this will improve performance since you do not need to access any object variable, but just a boolean that lays inside your class/object.
Related
I wanted to first thank you all for the help you've given me implicitly over the last few months! I've gone from not knowing how to access the VBA IDE in Excel to writing fully integrated analysis programs for work. I couldn't have done it without the community here.
I'm currently trying to overhaul the first iteration of a data analysis program I wrote while learning how to code in VBA. While purpose driven and only really legible to myself, the code worked; but was a mess. From folks on this site I picked up Martin's Clean Code and gave it a read on how to try and be a better programmer.
From Martin's Clean Code, it was impressed on me to prioritize abstraction and decoupling of my code to allow for higher degrees of maintenance and modularization. I found this out the hard way since very minor changes requested above my pay grade would require massive and confusing rewrites! I'm trying to eliminate that problem going forward.
I am attempting to rewrite my code in terms of single responsibility classes (at least, where it is possible) and I am a bit confused. I apologize if my question isn't clear or if I'm using the wrong terminology. I want to be able to generate a collection of specific strings (the names of our detectors to be specific) with no duplicates from raw instrument data files from my lab. The purpose of this function is to assemble a bunch of metadata in a class and use it to standardize our file system and prevent clerical errors from newbies and old hands when they use the analysis program.
The testing initialization sub is below. It pops open a userform asking for the user to select the filepaths of the three files in the rawdatafiles class; then it kills the userform to free memory. The metadata object is currently for testing and will be rewritten properly when I get the output I want:
Sub setup()
GrabFiles.Show
Set rawdatafiles = New cRawDataFiles
rawdatafiles.labjobFile = GrabFiles.tboxLabJobFile.value
rawdatafiles.rawdatafirstcount = GrabFiles.tboxOriginal.value
rawdatafiles.rawdatasecondcount = GrabFiles.tboxRecount.value
Set GrabFiles = Nothing
Dim temp As cMetaData
Set temp = New cMetaData
temp.labjobName = rawdatafiles.labjobFile
'this works fine!
temp.detectorsOriginal = rawdatafiles.rawdatafirstcount
' This throws run time error 424: Object Required
End Sub
The cMetadata class I have currently is as follows:
Private pLabjobName As String
Private pDetectorsOriginal As Collection
Private pDetectorsRecheck As Collection
Private Sub class_initialize()
Set pDetectorsOriginal = New Collection
Set pDetectorsRecheck = New Collection
End Sub
Public Property Get labjobName() As String
labjobName = pLabjobName
End Property
Public Property Let labjobName(fileName As String)
Dim FSO As New FileSystemObject
pLabjobName = FSO.GetBaseName(fileName)
Set FSO = Nothing
End Property
Public Property Get detectorsOriginal() As Collection
detectorsOriginal = pDetectorsOriginal
End Property
Public Property Set detectorsOriginal(originalFilepath As Collection)
pDetectorsOriginal = getDetectors(rawdatafiles.rawdatafirstcount)
End Property
When I step through the code it starts reading the "public property get rawdatafirstcount() as string" and throws the error after "End Property" and points back to the "temp.detectorsOriginal = rawdatafiles.rawdatafirstcount" line in the initialization sub.
I think I'm at least close because the temp.labjobName = rawdatafiles.labjobFile code executes properly. I've tried playing around with the data types since this is a collection being assigned by a string but I unsurprisingly get data type errors and can't seem to figure out how to proceed.
If everything worked the way I want it to, the following function would take the filepath string from the rawdatafiles.rawdatafirstcount property and return for me a collection containing detector names as strings with no duplicates (I don't know if this function works exactly the way I want since I haven't been able to get the filepath I want to parse properly in the initial sub; but I can deal that later!):
Function getDetectors(filePath As String) As Collection
Dim i As Integer
Dim detectorsCollection As Collection
Dim OriginalRawData As Workbook
Set OriginalRawData = Workbooks.Open(fileName:=filePath, ReadOnly:=True)
Set detectorsCollection = New Collection
For i = 1 To OriginalRawData.Worksheets(1).Range("D" & Rows.Count).End(xlUp).Row
detectorsCollection.Add OriginalRawData.Worksheets(1).Cells(i, 4).value, CStr(OriginalRawData.Worksheets(1).Cells(i, 4).value)
On Error GoTo 0
Next i
getDetectors = detectorsCollection
Set detectorsCollection = Nothing
Set OriginalRawData = Nothing
End Function
Thanks again for reading and any help you can offer!
temp.detectorsOriginal = rawdatafiles.rawdatafirstcount
' This throws run time error 424: Object Required
It throws an error because, as others have already stated, the Set keyword is missing.
Now with that out of the way, a Set keyword is NOT what you want here. In fact, sticking a Set keyword in front of that assignment will only buy you another error.
Let's look at this property you're invoking:
Public Property Get detectorsOriginal() As Collection
detectorsOriginal = pDetectorsOriginal
End Property
Public Property Set detectorsOriginal(originalFilepath As Collection)
pDetectorsOriginal = getDetectors(rawdatafiles.rawdatafirstcount)
End Property
You're trying to assign detectorsOriginal with what appears to be some String value that lives in some TextBox control on that form you're showing - but the property's type is Collection, which is an object type - and that's not a String!
Now look at the property that does work:
Public Property Get labjobName() As String
labjobName = pLabjobName
End Property
Public Property Let labjobName(fileName As String)
Dim FSO As New FileSystemObject
pLabjobName = FSO.GetBaseName(fileName)
Set FSO = Nothing
End Property
This one is a String property, with a Property Let mutator that uses the fileName parameter it's given.
The broken one:
Public Property Set detectorsOriginal(originalFilepath As Collection)
pDetectorsOriginal = getDetectors(rawdatafiles.rawdatafirstcount)
End Property
Is a Set mutator, takes a Collection parameter, and doesn't use the originalFilepath parameter it's given at all!
And this is where I'm confused about your intention: you're passing what has all the looks of a String except for its type (Collection) - the calling code wants to give it a String.
In other words the calling code is expecting this:
Public Property Let detectorsOriginal(ByVal originalFilepath As String)
See, I don't know what you meant to be doing here; it appears you're missing some pOriginalFilepath As String private field, and then detectorsOriginal would be some get-only property that returns some collection:
Private pOriginalFilePath As String
Public Property Get OriginalFilePath() As String
OriginalFilePath = pOriginalFilePath
End Property
Public Property Let OriginalFilePath(ByVal value As String)
pOriginalFilePath = value
End Property
I don't know what you're trying to achieve, but I can tell you this:
Don't make a Property Set member that ignores its parameter, it's terribly confusing code.
Don't make a Property (Get/Let/Set) member that does anything non-trivial. If it's not trivially simple and has a greater-than-zero chance of throwing an error, it probably shouldn't be a property. Make it a method (Sub, or Function if it needs to return a value) instead.
A word about this:
Dim FSO As New FileSystemObject
pLabjobName = FSO.GetBaseName(fileName)
Set FSO = Nothing
Whenever you Dim something As New, VBA will automatically instantiate the object whenever it's referred to. In other words, this wouldn't throw any errors:
Dim FSO As New FileSystemObject
Set FSO = Nothing
pLabjobName = FSO.GetBaseName(fileName)
Avoid As New if you can. In this case you don't even need a local variable - use a With block instead:
With New FileSystemObject
pLabjobName = .GetBaseName(fileName)
End With
May not be your issue but you're missing Set in your detectorsOriginal Set/Get methods:
Public Property Get detectorsOriginal() As Collection
Set detectorsOriginal = pDetectorsOriginal
End Property
Public Property Set detectorsOriginal(originalFilepath As Collection)
Set pDetectorsOriginal = getDetectors(rawdatafiles.rawdatafirstcount)
End Property
So the error is one I've made a time or two (or more). Whenever you assign an object to another object, you have to use the Set reserved word to assign the reference to the Object.
In your code do the following:
In Sub setup()
Set temp.detectorsOriginal = rawdatafiles.rawdatafirstcount
And in the cMetadata class change the Public Property Set detectorsOriginal(originalFilepath As Collection) property to the following:
Public Property Get detectorsOriginal() As Collection
Set detectorsOriginal = pDetectorsOriginal
End Property
Public Property Set detectorsOriginal(originalFilepath As Collection)
Set pDetectorsOriginal = getDetectors(rawdatafiles.rawdatafirstcount)
End Property
Also in your function Function getDetectors(filePath as String) as Collection change the statement afterNext i` to
Set getDetectors = detectorsCollection
Also, I'm very glad to hear that you've learned how to use VBA.
When you're ready to create your own Custom Collections, check out this post. Your own custom Collections.
I also book marked Paul Kelly's Excel Macro Mastery VBA Class Modules – The Ultimate Guide as well as his Excel VBA Dictionary – A Complete Guide.
If you haven't been to Chip Pearson's site you should do so. He has a ton of useful code that will help your delivery your projects more quickly.
Happy Coding.
I'm working on a project that requires I iterate through a list of controls on a tabpage to find all of the checkboxes. Then depending on the state of the box (checked or unchecked) select individual variables (filenames) to then perform either a batch rename or delete of files on the filesystem (cb.checked = perform action).
I have managed to create the "for each" for the iteration of the controls (thanks google) but I'm struggling to figure out how to pick the variables. They are all named differently, obviously, as are the checkboxes. Also the checkboxes are statically assigned to the form/tabpage. Here's what I have at the moment.
Public Sub delBut_code(ByRef fname As String)
If (Sanity = 1) Then
For Each cb As Control In Form1.Controls
If TypeOf cb Is CheckBox AndAlso DirectCast(cb,
CheckBox).Checked Then
If My.Computer.FileSystem.FileExists(fname) Then
My.Computer.FileSystem.DeleteFile(fname)
End If
End If
Next
MessageBox.Show("All Actions Completed Successfully")
Else
MessageBox.Show("Please select a File To Delete")
End If
End Sub
and here is an example of some of the variables:
Dim castle As String = selPath & "\zm_castle_loadingmovie.txt"
Dim factory As String = selPath &
"\zm_factory_load_factoryloadingmovie.txt"
Dim island As String = selPath & "\zm_island_loadingmovie.txt"
N.B selpath collects a user entered folder path and can be ignored here
I would really appreciate any pointers.
First, you can do much better with the loop:
Public Sub delBut_code(ByRef fname As String)
If Sanity <> 1 Then
MessageBox.Show("Please select a File To Delete")
Exit Sub
End If
Dim checked = Form1.Controls.OfType(Of CheckBox)().Where(Function(c) c.Checked)
For Each box As CheckBox in checked
Try
'A file not existing is only one reason among many this could fail,
' so it needs to be in a Try/Catch block.
' And once you're using a Try/Catch block anyway,
' the FileExists() check becomes a slow and unnecessary extra trip to the disk.
My.Computer.FileSystem.DeleteFile(fname)
Catch
'Do something here to let the user know it failed for this file
End Try
Next
MessageBox.Show("All Actions Completed")
End Sub
But now you need to know how have the right value in that fname variable. There's not enough information in the question for us to fully answer this, but we can give some suggestions. There a number of ways you could do this:
Set the Tag property in the Checkboxes when you build the string variables. Then fname becomes DirectCast(box.Tag, String).
Inherit a custom control from CheckBox to use instead of a normal Checkbox that has an additional String property for the file name. Set this property when you build the string variables.
Name your string variables in a way that you can derive the string variable name from the CheckBox variable name, and then use a Switch to pick the right string variable from each box.Name.
Keep a Dictionary(Of CheckBox, String) that maps the Checkboxes to the right string values.
But without knowing more context of the application, I hesitate to recommend any of these over the others as best for your situation.
Although I'm reasonable experienced VBA developer, I have not had the need to use class modules or collections but thought this may be my opportunity to extend my knowledge.
In an application I have a number of forms which all have the same functionality and I now need to increase that functionality. Towards that, I am trying to reorder a collection in a class module, but get an error 91 - object variable or with block not set. The collection is created when I assign events to controls. The original code I obtained from here (Many thanks mwolfe) VBA - getting name of the label in mousemove event
and has been adapted to Access. The assignments of events works well and all the events work providing I am only doing something with that control such as change a background color, change size or location on the form.
The problem comes when I want to reorder it in the collection - with a view to having an impact on location in the form. However I am unable to access the collection itself in the first place.
The below is my latest attempt and the error occurs in the collcount Get indicated by asterisks (right at the bottom of the code block). I am using Count as a test. Once I understand what I am doing wrong I should be able to manipulate it as required.
mLabelColl returns a correct count before leaving the LabelsToTrack function, but is then not found in any other function.
As you will see from the commented out debug statements, I have tried making mLabelColl Private and Dim in the top declaration, using 'Debug.Print mLabelColl.Count' in the mousedown event and trying to create a different class to store the list of labels.
I feel I am missing something pretty simple but I'm at a loss as to what - can someone please put me out of my misery
Option Compare Database
Option Explicit
'weMouseMove class module:
Private WithEvents mLbl As Access.Label
Public mLabelColl As Collection
'Dim LblList as clLabels
Function LabelsToTrack(ParamArray labels() As Variant)
Set mLabelColl = New Collection 'assign a pointer
Dim i As Integer
For i = LBound(labels) To UBound(labels)
'Set mLabelColl = New Collection events not assigned if set here
Dim LblToTrack As weMouseMove 'needs to be declared here - why?
Set LblToTrack = New weMouseMove 'assign a pointer
Dim lbl As Access.Label
Set lbl = labels(i)
LblToTrack.TrackLabel lbl
mLabelColl.Add LblToTrack 'add to mlabelcoll collection
'Set LblList as New clLabels
'LblList.addLabel lbl
Next i
Debug.Print mLabelColl.Count 'returns correct number
Debug.Print dsform.countcoll '1 - incorrect
End Function
Sub TrackLabel(lbl As Access.Label)
Set mLbl = lbl
End Sub
Private Sub mLbl_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
Dim tLbl As Access.Label
'Debug.Print LblList.Count 'Compile error - Expected function or variable (Despite Count being an option
'Debug.Print mLabelColl.Count 'error 91
'Debug.Print LblList.CountLbls 'error 91
Debug.Print collCount
End Sub
Property Get collCount() As Integer
*collCount = mLabelColl.Count* 'error 91
End Property
In order to have all the weMouseMove objects reference the same collection in their mLabelColl pointer, a single line can achieve it:
LblToTrack.TrackLabel lbl
mLabelColl.Add LblToTrack
Set LblToTrack.mLabelColl = mLabelColl ' <-- Add this line.
But please be aware that this leads to a circular reference between the collection and its contained objects, a problem that is known to be a source of memory leaks, but this should not be an important issue in this case.
I have two collections - collection1 and collection2
collection1 has a number of class objects in it and I am trying to fill collection2 with copies of the same objects using the following command:
Set collection2 = collection1
This doesn't give me the desired result though, because when I use
collection2.Remove 1
It removes the object at index 1 from both collections.
Below is the full code, which I hoped would output 10 objects in collection1 after removing one from collection2
Sub test()
Dim collection1 As Collection
Dim collection2 As Collection
Dim testObj As Worksheet
Dim i As Integer
Set collection1 = New Collection
Set collection2 = New Collection
For i = 1 To 10
collection1.Add testObj
Next i
Set collection2 = collection1
collection2.Remove 1
Debug.Print collection1.Count
End Sub
I tried the code below and it works but I'm looking to avoid filling both collections one by one if possible:
...
For i = 1 To 10
collection1.Add testObj
collection2.Add testObj
Next i
...
The reason I'm not so keen on this option is because ultimately I intend to use multiple collections, manipulating them and taking copies at various points so I would end up with lots of for loops in my code, rather than just one.
I am trying to fill collection2 with copies of the same objects using the following command:
Set collection2 = collection1
Yet that's not what that command does. The Set keyword doesn't "copy objects", and doesn't automagically know (or even care) that it's dealing with a Collection object that contains items.
The Set keyword assigns a reference. Nothing more, nothing less.
So what Set collection2 = collection1 does, is, literally:
Take the pointer for the collection1 object, and replace whatever collection2 is referring to with that.
That Set instruction is effectively discarding the object you created in the first place, when you did this:
Set collection2 = New Collection
You're not "copying objects" or "filling collection2" - you're overwriting its object reference, making collection2 point to the same object as collection1.
And since both pointers point to the same object... removing an item using either Collection is indeed going to be removing it from "both" collections, ...because there's only one collection object involved.
The (undocumented?) ObjPtr keyword can help shed some light on what's happening, too:
Set collection1 = New Collection
Debug.Print "collection1: " & ObjPtr(collection1)
Set collection2 = New Collection
Debug.Print "collection2: " & ObjPtr(collection2)
'the debug output contains 2 different addresses at this point
Set collection2 = collection1
Debug.Print "collection1: " & ObjPtr(collection1)
Debug.Print "collection2: " & ObjPtr(collection2)
'now the debug output clearly shows that
'both collection1 and collection2 are pointing to the same object
If you need copies of a collection, you need a function that takes a collection and returns a brand new object:
Public Function CopyCollection(ByVal source As Collection) As Collection
Dim result As New Collection
Dim item As Variant
For Each item In source
result.Add item
Next
Set CopyCollection = result
End Function
As already noted in comments though, this will only work if your collections aren't keyed. Because of how limited a Collection is (you can't iterate its keys), you'll have to use a Scripting.Dictionary instead, if you need to clone a keyed collection.
First of all, you dont need to Dim collection1 As Collection and Set collection1 = New Collection. This can be replaced by Dim collection1 As New Collection
Now, what you are doing is making the collection2 to contain the collection1. Its like putting lots of caps on a box (collection1) and then putting this box inside another box (collection2).
The alternative is to either fill both of them at the same time or do a code to copy the contents like
for i = 1 to collection1.count
collection2.add collection1.item(i)
next i
I have a CheckedListBox control that I fill with DataGridView Column HeaderText values. If these columns are visible, I would like to set the CheckedListBox Items to "Checked". My code is as follows:
For Each col As DataGridViewColumn In frmTimingP2P.dgvOverview.Columns
If col.Visible = True Then
For Each item In clbOverviewColumnOrder.Items
Dim intItemIndex As Integer = clbOverviewColumnOrder.Items.IndexOf(item)
If col.HeaderText = item.ToString Then
clbOverviewColumnOrder.SetItemCheckState(intItemIndex, CheckState.Checked)
End If
Next
End If
Next
Whenever this code runs, I get the following error:
"List that this enumerator is bound to has been modified. An enumerator can only be used if the list does not change."
What causes this? How can I get around this issue?
Thanks
Whenever are doing a for loop through an enumerator, the enumeration can't be modified or it throws this exception.
I'm not certain exactly why the enumeration would be changing here (it could be possible some other parts of your code are reacting to the change in check state) but one way to get around this would be to instantiate an enumerator and then loop through that instead.
I don't know VB, so here's some psuedo code!
e.g.
newEnumerator = ColumnOrder.Items.GetEnumerator()
begin loop through newEnumerator
set checkbox
end loop
So even if the Items list changes, it shouldn't affect this enumerator.
Thanks for the advice. I guess the error was related the the fact that, under some circumstances, you cannot modify a set of controls during a For...Next loop.
I have revised my code and ended up with the following:
Do While intCurrentItemIndex >= 0
Dim strCurrentItem As String = clbOverviewColumnOrder.Items(intCurrentItemIndex)
For Each col As DataGridViewColumn In frmTimingP2P.dgvOverview.Columns
If col.HeaderText = strCurrentItem Then
If col.Visible = True Then
clbOverviewColumnOrder.SetItemCheckState(intCurrentItemIndex, CheckState.Checked)
Else
clbOverviewColumnOrder.SetItemCheckState(intCurrentItemIndex, CheckState.Unchecked)
End If
End If
Next
intCurrentItemIndex -= 1
Loop