I'm having an issue with a class object not being recognized (error 91, object reference not set). Here's the code:
---Main (Standard Module)
Option Explicit
Public wbCode As Workbook
Public Sub MainSub()
Dim str As String
Dim tables As New CTables
Call SetExcelObjects
str = tables.shExclusions.Cells(20, 1) ---this produces error 91
End Sub
Public Sub SetExcelObjects()
Dim tables As New CTables
Dim str As String
Set wbCode = ThisWorkbook
Set tables.shExclusions = wbCode.Worksheets("Exclusions")
str = tables.shExclusions.Cells(20, 1) ---this line executes okay
End Sub
---CTables (Class Module)
Option Explicit
Public shExclusions As Worksheet
Try this:
---Main (Standard Module)
Option Explicit
Public wbCode As Workbook
Public Sub MainSub()
Dim str As String
Dim tables As New CTables
Call SetExcelObjects(tables)
str = tables.shExclusions.Cells(20, 1) ---this produces error 91
End Sub
Public Sub SetExcelObjects(tables as CTables)
Dim str As String
Set wbCode = ThisWorkbook
Set tables.shExclusions = wbCode.Worksheets("Exclusions")
str = tables.shExclusions.Cells(20, 1) ---this line executes okay
End Sub
---CTables (Class Module)
Option Explicit
Public shExclusions As Worksheet
Related
''''
Sub Main()
1. Dim obLibrary As New clsSacarioSymbols
Call CreateSacarioSymbol
End Sub
Sub CreateSacarioSymbol()
Dim SymbolEditor As Worksheet
Dim MsoShapes As Shapes
Dim SacarioGroup As Object
Dim SacarioGroupShapes As GroupShapes
Dim Index As Integer
Set SymbolEditor = Sheets("Symbol Editor")
Set MsoShapes = SymbolEditor.Shapes
'...This Block is for testing and replicates Engineer input to SymbolEditor
Dim ThisShape As Variant
For Each ThisShape In SymbolEditor.Shapes
ThisShape.Delete
Next ThisShape
SymbolEditor.Shapes.AddShape(msoShapeOval, 310.5, 30.75, 129, 99).Select
SymbolEditor.Shapes.AddShape(msoShapeRoundedRectangle, 285.75, 99, 174, 61.5).Select
'....End Testing Block
MsoShapes.SelectAll
If TypeName(Selection) = "DrawingObjects" Then
Set SacarioGroup = Selection.Group
Set SacarioGroupShapes = SacarioGroup.ShapeRange.GroupItems
Dim SacarioSymbol As New clsSacarioSymbol
SacarioSymbol.InitalizeClass SacarioGroupShapes
End If
End Sub
Class SacarioSymbol "Definition"
Private Sub class_initialize()
' MsgBox "Symbol Class Here"
End Sub
Public Sub InitalizeClass(SacarioSymbol As GroupShapes)
Dim obfrmGetSymbolName As New frmGetSymbolName
obfrmGetSymbolName.Show
SymbolName = obfrmGetSymbolName.GetSymbolName
obLibrary.addSymbol Me
End Sub
Class SacarioSymbol "End Definition"
Class SacarioSymbols "Definition"
Private SacarioSymbolLibrary
Private Sub class_initialize()
MsgBox "Sacario Library here"
Dim SacarioSymbol As Collection
End Sub
Public Sub addSymbol(symbol As Variant)
SacarioSymbolLibrary.add symbol
End Sub
Class SacarioSymbols "End Definition"
As I step through main() the line "Dim obLibrary As New clsSacarioSymbols" will not execute!
The yellow instruction line passes over this line of code.
Any direction will be appreciated.
I'm trying to create a code that will be executed against all userforms in my workbook. So I wanted to create a Class. However, I'm stuck at this point.
The class name is clsCmdUsrFormsE
Variable declaration within the class:
Public WithEvents EndUserforms As UserForm
Objects assignation code:
Dim UserFormsAll() As New clsCmdUsrFormsE
Sub Cmd_UsrF(Optional var1 As Boolean = False)
Dim iCmdUsrFrm As Integer, UsrForm As Object
iCmdUsrFrm = 0
For Each UsrForm In WBK0001.VBProject.VBComponents
If UsrForm.Type = 3 Then
iCmdUsrFrm = iCmdUsrFrm + 1
ReDim Preserve UserFormsAll(1 To iCmdUsrFrm)
Set UserFormsAll(iCmdUsrFrm).EndUserforms = UsrForm
End If
Next UsrForm
End Sub
& thew intent is to call Cmd_UsrF using a simple call
Sub Test()
Call Cmd_UsrF
End Sub
The problem I'm having is that it seems the Userform as Object is not compatible with the Class.
I've tried as well with
Public WithEvents EndUserforms As msforms.UserForm
But all I get is
Run-time error '13': Type mismatch
Any ideas?
You are tying to store VBComponent in MsForm and hence a type mismatch
Is this what you are trying?
Dim UserFormsAll() As New clsCmdUsrFormsE
Sub Cmd_UsrF(Optional var1 As Boolean = False)
Dim iCmdUsrFrm As Integer, UsrForm As Object
Dim frmname As String
iCmdUsrFrm = 0
For Each UsrForm In ThisWorkbook.VBProject.VBComponents
If UsrForm.Type = 3 Then
iCmdUsrFrm = iCmdUsrFrm + 1
ReDim Preserve UserFormsAll(1 To iCmdUsrFrm)
'~~> Get the Name of the form
frmname = UsrForm.Name
'~~> Load the form
Set UserFormsAll(iCmdUsrFrm).EndUserforms = UserForms.Add(frmname)
End If
Next UsrForm
End Sub
In Class Module
Public WithEvents EndUserforms As MSForms.UserForm
Note:
You can also bypass the variable frmname and directly use
Set UserFormsAll(iCmdUsrFrm).EndUserforms = UserForms.Add(UsrForm.Name)
I'm new to VBA and am trying to pass a string from a Sub to a Public Function (the Sub and Public Function are in separate modules but the same Workbook), split the string into an array in the Public Function, then pass the array back to the Sub from the Public Function.
I've searched though Stack Overflow and tried several different methods but they haven't worked. Below is the code I currently have which produces the following error:
Run-time error '9':
Subscript out of range
Any help would be appreciated. Apologies for the basic question. Thank you.
Sub:
Sub export()
Dim testString As String
Dim testValue As Variant
'testString could have any number of values
testString = "TEST1, TEST2, TEST3, TEST4"
'Call the Public Function below
testValue = splitText(testValue)
End Sub
Which calls the following Public Function in another module:
Public Function splitText() As Variant
Dim testValue As Variant
'Trying to import testString from the Sub to split it
testValue = Split(testString, ",")
'Define result of the Public Function
splitText = testValue
End Function
You need to use consistent variable names and pass argument in function call
Public Sub export()
Dim testString As String
Dim testValue As Variant
testString = "TEST1, TEST2, TEST3, TEST4"
testValue = splitText(testString) '<== consistent naming and passed as argument
End Sub
Public Function splitText(ByVal testString As String) As Variant '<== argument referenced in function signature
Dim testValue As Variant
testValue = Split(testString, ",") '<== consistent naming
splitText = testValue
End Function
I currently have instances of classes stored using the data structure presented in the image below. Each -List item is a dictionary and each -Info item is an instance of a class.
I read elsewhere that if you Set an instance variable equal to another instance, it just references the original instance. Is this correct?
I have been able to create a reference for fileInfo(1) (in the image) using the following code.
Dim prflInfo As File_Info
Set prflInfo = New File_Info
Set prflInfo = fileList.Items(0)
I have attempted to reference the branchInfo instance using the following code, but I get a Run-time error 13: Type mismatch when I attempt to do so.
Dim prbrInfo As Branch_Info
With prflInfo
Set prbrInfo = New Branch_Info
brKey = .getbrKey(0)
Set prbrInfo = .getbrItem(brKey)
End With
Edit: Included below is the code for the File_Info class. All other classes follow this basic model.
'Class Module: File_Info
'Initialise class variables
Private pfileID As Integer
Private pfilePath As String
Private pfileName As String
Private pbranchList As Scripting.Dictionary
'Declare variantcopy subroutine
Private Declare Sub VariantCopy Lib "OleAut32" (pvarDest As Any, pvargSrc As Any)
Private Sub Class_Initialize()
Set pbranchList = New Scripting.Dictionary
End Sub
Public Property Let fileID(pfileIDi As Variant)
pfileID = pfileIDi
End Property
Public Property Get fileID() As Variant
fileID = pfileID
End Property
Public Property Let filePath(pfilePathi As Variant)
pfilePath = pfilePathi
End Property
Public Property Get filePath() As Variant
filePath = pfilePath
End Property
Public Property Let fileName(pfileNamei As Variant)
pfileName = pfileNamei
End Property
Public Property Get fileName() As Variant
fileName = pfileName
End Property
Public Sub addbrConn(branch As Branch_Info)
pbranchList.Add branch.branchID, branch.brConn
Debug.Print "addbrConn ID: " & branch.branchID
End Sub
Public Sub addBranch(branch As Branch_Info)
pbranchList.Add branch.branchID, branch
Debug.Print pbranchList.Count
End Sub
Public Function countbrList()
countbrList = pbranchList.Count
End Function
Public Function getbrKey(Key As Variant)
getbrKey = pbranchList.Keys(Key)
End Function
Public Function getbrItem(Key As Variant)
getbrItem = GetByRefVariant(pbranchList.Items(Key))
End Function
Public Sub dpbrList()
With pbranchList
Debug.Print pbranchList.Count
For k = 1 To pbranchList.Count
Debug.Print .Keys(k - 1), .Items(k - 1)
Next k
End With
End Sub
Public Sub updbrList(branch As Branch_Info)
Dim branchID As String
branchID = branch.branchID
If pbranchList.exists(branchID) Then
pbranchList.Remove (branchID)
pbranchList.Add branchID, branch
Debug.Print "Complete: " & branchID & " added."
Else
Debug.Print "Error: " & branchID & "does not exist."
End If
End Sub
Private Function GetByRefVariant(ByRef var As Variant) As Variant
VariantCopy GetByRefVariant, var
End Function
Is there a way to reference the branchInfo class, to make it easier to extract the data within it?
Thanks!
Eeshwar
I do things differently in that I iterate through the keys list using a For ... each loop rather than referring to an item number. Here is a snippet that works using two levels.
You can ignore the lines where the property values are written to an array, but they were part of the original code.
cf.Dependents is a dictionary of cDependents within the cFamily object
'Declarations in Main Module
Dim dF As Dictionary, cF As cFamily, cD As cDependents
Dim I As Long, J As Long
Dim V As Variant, W As Variant
...
For Each V In dF
I = I + 1
Set cF = dF(V)
With cF
vRes(I, 1) = .FirstName
vRes(I, 2) = .LastName
vRes(I, 3) = .Birthdate
J = 2
For Each W In .Dependents
J = J + 2
Set cD = .Dependents(W)
With cD
vRes(I, J) = .Relation
vRes(I, J + 1) = .DepName
End With
Next W
End With
Next V
Note that in the sequence, as you show in your question:
set Obj = new Obj
set Obj = myClass(0)
the first line is unnecessary.
IMO it is possible to use simple VBA.Collection, here example for the FileList and BranchList. In this example List classes have Items and Info classes have reference to List where List is wrapper for a VBA.Collection. HTH
For more reading have a look e.g. here.
FileList Class
Option Explicit
Private m_fileInfoCollection As FileInfoCollection
Private Sub Class_Initialize()
Set m_fileInfoCollection = New FileInfoCollection
End Sub
Public Property Get Items() As FileInfoCollection
Set Items = m_fileInfoCollection
End Property
FileInfo Class
Option Explicit
Private m_branchList As BranchList
Private m_fileID As Integer
Private Sub Class_Initialize()
Set m_branchList = New BranchList
End Sub
Public Property Get FileID() As Integer
FileID = m_fileID
End Property
Public Property Let FileID(ByVal vNewValue As Integer)
m_fileID = vNewValue
End Property
Public Property Get BranchList() As BranchList
Set BranchList = m_branchList
End Property
FileInfoCollection Class
Option Explicit
Private m_collection As VBA.Collection
Private Sub Class_Initialize()
Set m_collection = New VBA.Collection
End Sub
Public Sub Add(ByVal newItem As FileInfo)
m_collection.Add newItem, CStr(newItem.FileID)
End Sub
Public Function ItemByKey(ByVal key As String) As FileInfo
Set ItemByKey = m_collection(key)
End Function
Public Function ItemByIndex(ByVal index As Long) As FileInfo
Set ItemByIndex = m_collection(index)
End Function
Public Function Count() As Long
Count = m_collection.Count
End Function
BranchList Class
Option Explicit
Private m_branchInfoCollection As BranchInfoCollection
Private Sub Class_Initialize()
Set m_branchInfoCollection = New BranchInfoCollection
End Sub
Public Property Get Items() As BranchInfoCollection
Set Items = m_branchInfoCollection
End Property
BranchInfo Class
Option Explicit
Private m_branchID As Integer
Public Property Get branchID() As Integer
branchID = m_branchID
End Property
Public Property Let branchID(ByVal vNewValue As Integer)
m_branchID = vNewValue
End Property
BranchInfoCollection Class
Option Explicit
Private m_collection As VBA.Collection
Private Sub Class_Initialize()
Set m_collection = New VBA.Collection
End Sub
Public Sub Add(ByVal newItem As BranchInfo)
m_collection.Add newItem, CStr(newItem.branchID)
End Sub
Public Function ItemByKey(ByVal key As String) As BranchInfo
Set ItemByKey = m_collection(key)
End Function
Public Function ItemByIndex(ByVal index As Long) As BranchInfo
Set ItemByIndex = m_collection(index)
End Function
Public Function Count() As Long
Count = m_collection.Count
End Function
Standard Module
Option Explicit
Sub Demo()
' Fill
Dim bi As BranchInfo
Set bi = New BranchInfo
bi.branchID = 111
Dim fi As FileInfo
Set fi = New FileInfo
fi.FileID = 222
fi.BranchList.Items.Add bi
Dim fl As FileList
Set fl = New FileList
fl.Items.Add fi
' Get
Dim fi1 As FileInfo
Set fi1 = fl.Items.ItemByIndex(1)
Dim bi1 As BranchInfo
Set bi1 = fi1.BranchList.Items(1)
End Sub
I am trying to set up a custom object model using an example I found in an answered question here on stackoverflow.
VBA Classes - How to have a class hold additional classes
Here is the code I have created based on the answer.
Standard Module
Sub test()
Dim i As Long
Dim j As Long
'code to populate some objects
Dim AssemList As Collection
Dim Assem As cAssem
Dim SubAssemList As Collection
Dim SubAssem As cSubAssem
Set AssemList = New Collection
For i = 1 To 3
Set SubAssemList = New Collection
Set Assem = New cAssem
Assem.Description = "Assem " & i
For j = 1 To 3
Set SubAssem = New cSubAssem
SubAssem.Name = "SubAssem" & j
SubAssemList.Add SubAssem
Next j
Set Assem.SubAssemAdd = SubAssemList '<------ Object variable or With Block not Set
AssemList.Add Assem
Next i
Set SubAssemList = Nothing
'write the data backout again
For Each clock In AssemList
Debug.Print Assem.Description
Set SubAssemList = Assem.SubAssems
For Each SubAssem In SubAssemList
Debug.Print SubAssem.Name
Next
Next
End Sub
cAssem Class
Private pDescription As String
Private pSubAssemList As Collection
Private Sub Class_Initialize()
Set pSubAssems = New Collection
End Sub
Public Property Get Description() As String
Description = pDescription
End Property
Public Property Let Description(ByVal sDescription As String)
pDescription = sDescription
End Property
Public Property Get SubAssems() As Collection
Set SubAssems = pSubAssemList
End Property
Public Property Set SubAssemAdd(AssemCollection As Collection)
For Each AssemName In AssemCollection
pSubAssemList.Add AssemName ' <------- This is the line that is triggering the error
Next
End Property
cSubAssem Class
Private pSubAssemName As String
Public Property Get Name() As String
Name = pSubAssemName
End Property
Public Property Let Name(ByVal sName As String)
pSubAssemName = sName
End Property
I have not changed anything in the code except class names and variable names and from my limited point of view I cannot understand the cause of the error.
I am just starting to really dig into objects and Class Modules in VBA so I appreciate any knowledge this community could pass my way.
Many Thanks
You have a typo in your sub class initializer:
Private Sub Class_Initialize()
Set pSubAssems = New Collection
End Sub
should read:
Private Sub Class_Initialize()
Set pSubAssemList = New Collection
End Sub