I am trying to create a list of objects in VBA but it seems like new objects are not being created and values are being updated to a single instance of a class.
This is the class
' ---------------------------------------------------------------
'
' Class to represent Program Increment
'
' ---------------------------------------------------------------
Public name As String
Public sprints As New Collection
This is the calling code:
' get the unique pi values
Dim piList As New Collection
For r = firstRow To lastRow
currentVal = Cells(r, 2)
On Error Resume Next
Dim currentPi As New ProgramIncrement
currentPi.name = currentVal
piList.Add currentPi, currentVal
On Error GoTo 0
Next
This is the output for the first pi
And this is the output for the second pi
I'm not seeing what I'm doing wrong base upon online documents such as this.
https://analystcave.com/vba-vba-class-tutorial/
As New creates an auto-instantiated object. Dim statements aren't executable, so there's only one object indeed.
Remove As New and use Set ... = New statements to create new objects.
Dim currentPi As ProgramIncrement
Set currentPi = New ProgramIncrement
Dim being inside the loop makes no difference - on one hand it makes it easy to later refactor and extract the loop body into its own procedure scope; on the other hand it can be read as though a new variable is created at every iteration, but that's not how scopes work in VBA: the smallest scope is procedure scope - blocks (e.g. loop bodies) don't scope anything.
This worked per Mathieu Guindon's answer.
Dim piList As New Collection
Dim currentPi As ProgramIncrement
For r = firstRow To lastRow
currentVal = Cells(r, 2)
Set currentPi = New ProgramIncrement
currentPi.name = currentVal
On Error Resume Next
piList.Add currentPi, currentVal
On Error GoTo 0
Next
Related
I'm setting up a macro to open different websites based on what deal ID cells are not empty in an Excel sheet. It will create four objects and store the objects in a collection. Four is an arbitrary number because I won't ever need more than two, but I created more just in case.
The macro loops through the Excel sheet and picks out as many deal IDs as necessary (deal IDs are appended to the url to go to the different sites).
I get the error saying
Object variable or With block variable not set
on the highlighted line below.
Sub TransactionMatching()
Dim first_day As String
Dim ieapp As Object
Dim ieapp2 As Object
Dim ieapp3 As Object
Dim ieapp4 As Object
' collection to hold deal names
Dim dealnameArray As New Collection
' collection to hold deal IDs
Dim dealIDArray As New Collection
' collection to hold required ieapp objects
Dim totalDealObjectArray As New Collection
' add all ieapp objects to the collection
totalDealObjectArray.Add ieapp
totalDealObjectArray.Add ieapp2
totalDealObjectArray.Add ieapp3
totalDealObjectArray.Add ieapp4
Windows("transaction_matching.xlsm").Activate
' loop through each row in the excel sheet and add the deal names and deal IDs...
' ...with check marks nect to them to their respective collections
For i = 5 To 51
If IsEmpty(Range("C" & i).Value) = False Then
dealnameArray.Add (Range("A" & i).Value)
dealIDArray.Add (Range("B" & i).Value)
End If
Next
'get the required number of objects from the ieapp object collection
For i = 1 To dealnameArray.Count - 1
' set each object in ieapp object collection to a new internet explorer object
Set totalDealObjectArray(i) = New InternetExplorerMedium
totalDealObjectArray(i).Visible = True
' define the last business day
lastDay = DateSerial(Year(Date), Month(Date), 0)
' define the first day of the previous month
first_day = lastDay - Day(lastDay) + 1
With totalDealObjectArray(i)
.navigate "http://website" & dealIDArray(i)
Application.DisplayFullScreen = True
Call busy((totalDealObjectArray(i)))
Call DoThings((totalDealObjectArray(i)))
End With
Next
Application.WindowState = xlNormal
Application.WindowState = xlMaximized
End Sub
Collections in VBA use .Add and .Remove to add and remove items. Changing values of items in collection is done through additional code - How to change value of an item of a collection
The collection.Item(N) displays the value, but does not change it. Concerning the code, you can add the new object and thus it would be set:
Sub TransactionMatching()
Dim i As Long
Dim totalDealObject As New Collection
totalDealObject.Add New InternetExplorerMedium
totalDealObject.Add New InternetExplorerMedium
totalDealObject.Add New InternetExplorerMedium
totalDealObject.Add New InternetExplorerMedium
For i = 1 To 4
Debug.Print totalDealObject.Item(i).FullName
Next
End Sub
If the task is to add the items in a collection through a loop, then something like this can work, adding InternetExplorerMedium on every second position of the collection:
Sub TransactionMatching()
Dim i As Long
Dim totalDealObject As New Collection
For i = 1 To 10
If i Mod 2 = 0 Then
totalDealObject.Add New InternetExplorerMedium
Else
totalDealObject.Add i
End If
Next
End Sub
Vityata correctly identified the problem:
The collection.Item(N) displays the value, but does not change it
In other words, the = assignment operator is NOT going against the null object reference at the specified collection index; the left-hand-side assignment target is the default member of the retrieved object, and since the retrieved object is Nothing, that implicit default member call is why you're getting error 91, because any member call (explicit or not) against Nothing will always throw error 91.
Now, if the reference was set, it would still be an implicit default member call to resolve the LHS of the assignment operation; if the object doesn't have a default member, the run-time error would be 438 "object does not support property or method".
Default Member?
Many classes have a default member. That is, a member that can be omitted. One example would be Collection.Item - these two statements do exactly the same thing:
Debug.Print myCollection.Item(i)
Debug.Print myCollection(i) '<~ call to .Item default member is implicit
Rubberduck has several code inspections that could have found and prevented this bug... and others waiting to be caught:
Variable 'ieapp' is used but not assigned
Variable 'ieapp' is not assigned
The expression 'totalDealObjectArray(i)' contains an indexed default member access to 'VBE7.DLL;VBA.Collection.Item'
Variable 'i' is not declared
Variable 'first_day' is not used
Member 'Range' implicitly references 'ActiveSheet'
I'm trying to implement my own collection in VBA in which to store a list of objects. I'm new to VBA and I need to find a way in which to implement a solution.
What I have: a list of objects with different properties on which the most important is the duration of a specific action.
What I need: I want a sorted list of objects by using a comparator based on a time property (duration of a specific action).
What kind of Collection do you recommend? I need to create my own helper method in order to sort the elements of the collection? VBA has a comparator interface that I can implement on my own collection object?
I have solved quite similar problem using Types.
Option Compare Database
Option Explicit
Type tPersonalData
FamilyName As String
Name As String
BirthDate As Date
End Type
Type tHuman
PersonalData As tPersonalData
Height As Integer
CashAmount As Integer
End Type
Public Sub subUsage()
Dim Humans(10) As tHuman
Dim HumanCurrent As tHuman
With HumanCurrent
.CashAmount = 100
.Height = 190
.PersonalData.FamilyName = "Smith"
.PersonalData.Name = "John"
.PersonalData.BirthDate = CDate("01.01.1980")
End With
Humans(1) = HumanCurrent
End Sub
So after that you can implement your own sorting functions for an array, using given field.
I have created a sorting method based on Van Ng's, in order to sort my objects like that:
Public Sub sortedCollectionByDuration()
Dim vItm As ClsCron
Dim i As Long, j As Long
Dim vTemp As Variant
Set vTemp = New ClsCron
Set vItm = New ClsCron
For i = 1 To myCol.Count - 1
For j = i + 1 To myCol.Count
If myCol(i).Duration > myCol(j).Duration Then
Set vTemp = myCol(j)
myCol.Remove j
myCol.add vTemp, , i
End If
Next j
Next i
-- testing or logging
For Each vItm In myCol
Debug.Print vItm.ModuleName & " " & vItm.FunctionName & VBA.Format(vItm.Duration, "HH:MM:SS")
Next vItm
End Sub
The problem that I face is, I have a object/collection which will be created on the bottom of the stack and I have a program 3 levels deep, the collection will be only used at the 3(top) level, the first item will be used and removed from the collection, but I want to keep it for the entirety of the program as the next step needs to use the next item in the collection until the whole thing is done.
The best way I would like to do it is the create that collection in the bottom layer which is where the collection will be used, and keep the collection even if the collection is out of scope.
The way I am doing it right now is to create the collection at the bottom most level and pass it down the chain, cause if I create it in the top layer it will be deleted after it goes out of scope
I feel like there must be a better way solve my problem, but I just can't find it. Does anyone knows the answer?
I just set up some text in excel as follows
(A) (1)
(B) (2)
(C) (3)
(D) (4)
(E) (5)
'The Code works, but what I am asking is it possible to dont pass dict through all those sub
Sub Main()
Static dict As New Dictionary
Dim x As Integer
Set dict = readrange
Do While x < 3
somesub dict
x = x + 1
Loop
End Sub
'----------------------- Next Module ----------------------------------------------------
Sub somesub(dict As Dictionary) '<----------------------- Dont want this dict
'some code which doesnt not use the dict
Dictchange dict
End Sub
'----------------------- Next Module ----------------------------------------------------
Sub Dictchange(dict As Dictionary) '<----------------------- Dont want this dict too
Cells(dict(dict.Keys(0)), 4) = "Done"
'Is it possible to call dict in Main without pass the chain
'I cant use public as in the real code, "somesub" and "Dictchange" are in different module
'I could use Global, but i always feel like it just a "Dirty" way to fix thing
dict.Remove dict.Keys(0)
End Sub
'----------------------- Next Module ----------------------------------------------------
'In the real code, this is one function in a class Module
Function readrange() As Dictionary
Dim temp As New Dictionary
For i = 1 To 5
temp.Add Cells(i, 1).Value, Cells(i, 2).Value
Next i
Set readrange = temp
End Function
I hope this would help
As I already told in my comment: Make your dict a global variable.
Option Explicit
Public dict As Dictionary 'this is globally defined in a module
Sub Main()
Dim x As Long
Set dict = ReadRangeToDict
Do While x < 3
SomeProcedure
x = x + 1
Loop
End Sub
Function ReadRangeToDict() As Dictionary
Dim TempDict As New Dictionary
Dim iRow As Long
For iRow = 1 To 5
If Not TempDict.Exists(Cells(iRow, 1).Value) Then 'check if key already exists to prevent errors!
TempDict.Add Cells(iRow, 1).Value, Cells(iRow, 2).Value
End If
Next iRow
Set ReadRangeToDict = TempDict
End Function
So you can access it in any other procedure/function without giving it as a parameter.
Sub SomeProcedure()
'output the dict in the immediate window
Dim itm As Variant
For Each itm In dict
Debug.Print itm, dict(itm)
Next itm
End Sub
I am working on a quicker way to cycle through a column in a table in some previously written code. The problem I have is that at some point I need to assign the subject of the With statement (a single cell range) to an array of ranges, depending on the value of the range and nearby cells.
I have trimmed the code and taken only those bits which are necessary to the problem. See below:
Dim wb As Workbook
Dim wsFit As Worksheet
Dim fittingsTable As ListObject
ReDim fittings(0) As Range
Dim x As Integer
Dim y As Integer
Set wb = ActiveWorkbook
Set wsFit = wb.Worksheets("Fittings")
Set fittingsTable = wsFit.ListObjects("FittingsTable")
For x = 1 To fittingsTable.DataBodyRange.Rows.Count
With fittingsTable.DataBodyRange(x, 15)
If .Value <> vbNullString And .Value <> "0" Then
If .Offset(0, -2).Value <> "TBC" Then
'Do some stuff
Set fittings(y) = 'PROBLEM HERE
Else
'Do other stuff here
End If
End If
End With
Next
I want to assign fittingsTable.DataBodyRange(x, 15) to fittings(y), but I have no idea how to access the range that is the subject of the With statement.
I know that I could assign the desired range to another variable before the With statement begins, and then assign that variable to fittings(y) instead, but I feel like there must be a simple way to access the initial subject of the With statement so that I don't end up clogging my code with yet more variables. I could also use the .Address property to assign the range using the worksheet, but at this point I'm genuinely curious about finding a more direct way.
Your With block is holding a Range object reference.
You can use the .Cells (parameterless) property to retrieve a reference to that Range object:
Set fittings(y) = .Cells
Or, to make it more explicit that it's a single-cell range:
Set fittings(y) = .Cells(1, 1)
This makes an implicit default member call that ultimately ends up being equivalent to:
Set fittings(y) = .Item(1, 1)
That works for a Range. For a lot of other classes, there is no property that returns a reference to the object. For example, a Collection:
With New Collection
.Add 42
Set foo = ???? ' can't get a reference to the Collection object!
End With
The general solution is to extract the With block variable into a local variable, and now that variable is accessible just like any other local:
Dim c As Collection
Set c = New Collection
With c
.Add 42
Set foo = c
End With
For a custom class that you control, you can have a property getter that returns Me:
Public Property Get Self() As Class1
Set Self = Me
End Property
And now the With block variable is accessible through that property:
With New Class1
.Something = 42
Set foo = .Self
End With
I keep having an issue with some code in VBA Excel was looking for some help!
I am trying to sort through a list of names with corresponding phone numbers, checking for multiple names under the same phone number. Then post those names to a separate sheet.
So far my code is:
Sub main()
Dim cName As New Collection
For Each celli In Columns(3).Cells
Sheets(2).Activate
On Error GoTo raa
If Not celli.Value = Empty Then
cName.Add Item:=celli.Row, Key:="" & celli.Value
End If
Next celli
On Error Resume Next
raa:
Sheets(3).Activate
Range("a1").Offset(celli.Row - 1, 0).Value = Range("a1").Offset(cName(celli.Value) - 1, 0).Value
Resume Next
End Sub
When I try to run the code it crashes Excel, and does not give any error codes.
Some things I've tried to fix the issue:
Shorted List of Items
Converted phone numbers to string using cstr()
Adjusted Range and offsets
I'm pretty new to all this, I only managed to get this far on the code with help from other posts on this site. Not sure where to go with this since it just crashes and gives me no error to look into. Any ideas are appreciated Thank you!
Updated:
Option Explicit
Dim output As Worksheet
Dim data As Worksheet
Dim hold As Object
Dim celli
Dim nextRow
Sub main()
Set output = Worksheets("phoneFlags")
Set data = Worksheets("filteredData")
Set hold = CreateObject("Scripting.Dictionary")
For Each celli In data.Columns(3).Cells
On Error GoTo raa
If Not IsEmpty(celli.Value) Then
hold.Add Item:=celli.Row, Key:="" & celli.Value
End If
Next celli
On Error Resume Next
raa:
nextRow = output.Range("A" & Rows.Count).End(xlUp).Row + 1
output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
'data.Range("B1").Offset(celli.Row - 1, 0).Value = Range("B1").Offset(hold
Resume Next
End Sub
Update2:
Used hold.Exists along with an ElseIf to remove the GoTo's. Also changed it to copy and paste the row to the next sheet.
Sub main()
Set output = Worksheets("phoneFlags")
Set data = Worksheets("filteredData")
Set hold = CreateObject("Scripting.Dictionary")
For Each celli In data.Columns(2).Cells
If Not hold.Exists(CStr(celli.Value)) Then
If Not IsEmpty(celli.Value) Then
hold.Add Item:=celli.Row, Key:="" & celli.Value
Else
End If
ElseIf hold.Exists(CStr(celli.Value)) Then
data.Rows(celli.Row).Copy (Sheets("phoneFlags").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0))
'output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
End If
Next celli
End Sub
When developing code, don't try (or be afraid of) errors as they are pointers to help fix the code or the logic. As such, don't use On Error unless it is absolutely indicated in the coding algorithm (*). using On Error when not necessary only hides errors, does not fix them and when coding it is always better to avoid the errors in the first place (good logic).
When adding to the Dictionary, first check to see if the item already exists. The Microsoft documentation notes that trying to add an element that already exists causes an error. An advantage that the Dictionary object has over an ordinary Collection object in VBA is the .exists(value) method, which returns a Boolean.
The short answer to your question, now that I have the context out of the way, is that you can first check (if Not hold.exists(CStr(celli.Value)) Then) and then add if it does not already exist.
(*) As a side note, I was solving an Excel macro issue yesterday which took me most of the day to nut out, but the raising of errors and the use of debugging code helped me make some stable code rather than some buggy but kind-of-working code (which is what I was fixing in the first place). However, the use of error handling can be a short cut in some instances such as:
Function RangeExists(WS as Worksheet, NamedRange as String) As Boolean
Dim tResult as Boolean
Dim tRange as Range
tResult = False ' The default for declaring a Boolean is False, but I like to be explicit
On Error Goto SetResult ' the use of error means not using a loop through all the named ranges in the WS and can be quicker.
Set tRange = WS.Range(NamedRange) ' will error out if the named range does not exist
tResult = True
On Error Goto 0 ' Always good to explicitly limit where error hiding occurs, but not necessary in this example
SetResult:
RangeExists = tResult
End Function