Trouble with late-bound functions - excel

Greetings I have the following code:
Private Sub makeNewReports()
Dim wkSheet As Worksheet
Set wkSheet = ActiveWorkbook.Worksheets("Grades")
Dim i As Long
Dim myMap As Dictionary
Set myMap = New Dictionary
For i = 4 To 6 'wkSheet.Range("a1").End(xlToRight).Column - 1
Dim myVals As dateValueItem
myVals.total_value = wkSheet.Cells(2, i)
myVals.items = wkSheet.Cells(1, i)
myVals.student_value = wkSheet.Cells(4, i)
myMap.Add wkSheet.Cells(3, i), myVals
Next i
End Sub
and the following code for dateValueItem
Option Explicit
Public Type dateValueItem
total_value As Long
items As String
student_value As Long
End Type
when I run the above code I get the problem
'Compile Error: Only user-defined types defined in public object modules can be coerced to or from a variant or passed to late bound functions'
I'm trying to map together 3 different values to a specific date; the dates are held in row three. Row 2 and 4 has numerical values, and row 1 has string values. The hope is to be able to organize all of these together so I can eventually connect descriptions and values to dates.

This might be the quickest way. Create a class and name it dateValueItem
Option Explicit
Public total_value As Long
Public items As String
Public student_value As Long
And change your code to
Option Explicit
Private Sub makeNewReports()
Dim wkSheet As Worksheet
Set wkSheet = ActiveWorkbook.Worksheets("Grades")
Dim i As Long
Dim myMap As Dictionary
Set myMap = New Dictionary
Dim myVals As dateValueItem
For i = 4 To 6 'wkSheet.Range("a1").End(xlToRight).Column - 1
Set myVals = New dateValueItem
myVals.total_value = wkSheet.Cells(2, i)
myVals.items = wkSheet.Cells(1, i)
myVals.student_value = wkSheet.Cells(4, i)
myMap.Add wkSheet.Cells(3, i), myVals
Next i
End Sub

Related

VBA: How to loop through multiple variant arrays of the same length and turn them into Objects

I currently have 3 separate variants that are all arrays consisting of 13 rows and 1 column. One variant represents names, another represents changes and the last represents occurrences. Please see my starter code below:
Sub watchList()
Dim names As Variant
names = Sheets("Watch Calculations").Range("B4:B16")
Dim changes As Variant
changes = Sheets("Watch Calculations").Range("G4:G16")
Dim occurances As Variant
occurrences = Sheets("Watch Calculations").Range("G22:G34")
End Sub
I also have a class called counterParty with the following fields:
Public Name As String
Public changeStatus As String
Public negativeOccurences As Integer
How can I loop through all 3 variants at the same time and input the values into an object of the counterParty class based on the row number of each variant. Please see psuedo code below:
Dim i As Integer
Dim MyArray(1 To 13) As Integer
For i = 1 To UBound(MyArray)
'psuedo code stars here
create new object of class counterParty
set object.Name = names(i,1)
set object.changeStatus = changes(i,1)
set object.negativeOccurences= occurrences.get(i,1)
add object to array of counterParty objects
Next i
Try this out
First the class module:
Private pName As String
Private pchangeStatus As String
Private pnegativeOccurrences As Long
Public Property Get Name() As String
Name = pName
End Property
Public Property Let Name(lName As String)
pName = lName
End Property
Public Property Get changeStatus() As String
changeStatus = pchangeStatus
End Property
Public Property Let changeStatus(lchangeStatus As String)
pchangeStatus = lchangeStatus
End Property
Public Property Get negativeOccurrences() As Long
negativeOccurrences = pnegativeOccurrences
End Property
Public Property Let negativeOccurrences(lnegativeOccurrences As Long)
pnegativeOccurrences = lnegativeOccurrences
End Property
Then the module:
Dim names As Variant
names = Sheets("Watch Calculations").Range("B4:B16")
Dim changes As Variant
changes = Sheets("Watch Calculations").Range("G4:G16")
Dim occurrences As Variant
occurrences = Sheets("Watch Calculations").Range("G22:G34")
Dim i As Long
Dim clsarr(1 To 13) As Object 'You can use lbound and ubound on names() to get dynamic values
Dim mycls As Class1
For i = 1 To UBound(names)
Set mycls = New Class1 'Overwrite current object
'assign values to the class properties
mycls.Name = names(i, 1)
mycls.changeStatus = changes(i, 1)
mycls.negativeOccurrences = occurrences(i, 1)
Set clsarr(i) = mycls
Next i

Collection of Objects Passing a new UDT to each Object while Looping thru an Array

My aMRecon array is 2500 rows x 65 columns. I need to evaluate up to 10+ columns within each single row and thus I believe I need to create an object representing each row. I have created a UDT and in a basic procedure below I am trying to create an object for each row with each object having an .EntityID property (which is the cell value in each row within Column B or Column 2).
Public Type BreakInfo
EntityID As String
IssueName As String
ValDate As Date
LedgerAMT As Long
NetAMTL As Long
PriceDiff As Long
End Type
Sub Fill_Objects()
Dim aMrow As Integer, aMcol As Integer
Dim BI As BreakInfo
For aMcol = LBound(aMRecon, 2) To UBound(aMRecon, 2)
For aMrow = LBound(aMRecon, 1) To UBound(aMRecon, 1)
If aMcol = 2 Then
Debug.Print aMRecon(aMrow, aMcol)
Set ObjLSL = New Collection
BI.EntityID = aMRecon(aMrow, aMcol)
End If
Next aMrow
Next aMcol
End If
End Sub
Do I need to somehow create a collection of objects? Could someone please show me an example to help. As of right now I think I only have one object and the .EntityID property keeps getting overwritten. Thank you
In Fact each row at will only have 1 property, basically each property is a Column Header. Am I going about this the most efficient way? Eventually I will need to evaluate each property within an object and categorize it.
Inserted a ClassModule entitle BreakInfo
'Public EntityID As String
Public EntityID As Variant
Public IssueName As String
Public ValDate As Date
Public LedgerAMT As Long
Public NetAMTL As Long
Public PriceDiff As Long
That's all that's in the class.
You need to first create (insert) a Class Module, name it BreakInfo, and give it Public members like this:
Option Explicit
Public EntityID As String
Public IssueName As String
Public ValDate As Date
Public LedgerAMT As Long
Public NetAMTL As Long
Public PriceDiff As Long
Then you can use something like this:
Sub Fill_Objects()
Dim aMrow As Integer, aMcol As Integer
Dim BI As BreakInfo
Dim ObjLSL As Collection
Dim key As Long
'Create the Collection instance.
Set ObjLSL = New Collection
For aMcol = LBound(aMRecon, 2) To UBound(aMRecon, 2)
For aMrow = LBound(aMRecon, 1) To UBound(aMRecon, 1)
If aMcol = 2 Then
'Instantiate a BreakInfo.
Set BI = New BreakInfo
BI.EntityID = aMRecon(aMrow, aMcol)
'...
key = key + 1
ObjLSL.Add BI, CStr(key)
End If
Next aMrow
Next aMcol
End Sub
Notice that the collection is instantiated once, before the loops. A collection can't ingest variables of user-defined types, but it will gladly gobble up object instances.
Edit
The question has changed. If you worry about efficiency, you could hardcode aMcol = 2 and do without the outer For and the If aMcol = 2. Other than that, I don't understand what you're trying to do with your values.

Why is my public dictionary popping out 1004 errors?

I'm trying to establish a public dictionary to query at various points in the use of my document. But- the document appears to "forget" about the dictionary assigned? Is there a problem with my code?
Dim hedDict As Scripting.Dictionary
Public Function headDict()
On Error Resume Next
Dim i As Long
Dim z As Long
Dim x As Variant
Dim c As Variant
Dim d As Variant
Set hedDict = New Dictionary
z = Range("A1").End(xlToRight).Column
Sheets("New Item Entry").Select
Range("A2").Select
i = 1
Do While i <= z
c = Columns(i).Rows(1).Value
d = i
Call addToDict(hedDict, c, d)
i = i + 1
Loop
End Function
Function addToDict(dic, iteem, val)
dic.Add iteem, val
End Function
Sub ChckTst()
Dim x as Long
x = Cells(i, hedDict("Order UOM Price")).Value
MsgBox (x)
End Sub
The subroutine above does various other things before calling on the dictionary, such as calling a plethora of variables, assigning an array, and creating a collection. If that could interfere, please let me know.
Thank you

Best way to lookup a list of character strings against dictionary to output English words

I've got a list of about 20,000 strictly alpha/text character strings outputted as a CSV file to Excel, but it's quite a mess.
What I want to do is query a separate, reference file of English dictionary words so that I can essentially create a lookup and return the dictionary word, minus a load of the text noise that is either prepended or appended to the string. Example below.
xyzbuildingcontractor = Building Contractor
upholsteryabcdef = Upholstery
lmnoengineer = Engineer
As a relative n00b programmer I just want to gauge opinion as to the best way to do this and whether Excel is the best platform to use.
Any guidance would be very gratefully recieved, thanks in advance.
Jim
Ok, this is a very rough draft which you might have to tweak, but the general idea is this:
A Trie is used to build a dictionary of words
A clsTrieIterator class allows tracking multiple words at a time within the Trie
The string to be tested is parsed one character at a time, each one starting a new clsTrieIterator
All the existing active clsTrieIterators consume each next character, and if the resulting combination of characters is not possible given the dictionary, it stops being tracked
Here is a short example of the use:
Public Sub Main()
Dim wf As clsWordFinder
Set wf = New clsWordFinder
wf.Add "Building"
wf.Add "Contractor"
wf.Add "Upholstery"
wf.Add "Engineer"
Debug.Print wf.getWordsFromString("xyzbuildingcontractor")
Debug.Print wf.getWordsFromString("upholsteryabcdef")
Debug.Print wf.getWordsFromString("lmnoengineer")
End Sub
Which outputs the following to the immediate window in VBA:
Building Contractor
Upholstery
Engineer
...and below are the classes.
clsTrieNode is each individual node of the tree. It represents a single letter and it may have up to 26 children, assuming they form valid words in the dictionary. If the combination of characters, node by node down the tree from the root to this point forms a word, the Trie will set "isWord".
Option Compare Database
Option Explicit
Public KeyChar As String
Public isWord As Boolean
Private m_Children(0 To 25) As clsTrieNode
Public Property Get Child(strChar As String) As clsTrieNode
'better be ONE char
Set Child = m_Children(charToIndex(strChar))
End Property
Public Property Set Child(strChar As String, oNode As clsTrieNode)
Set m_Children(charToIndex(strChar)) = oNode
End Property
Private Function charToIndex(strChar As String) As Long
charToIndex = Asc(strChar) - 97 'asc("a")
End Function
clsTrie is the public facing interface to interact with the tree of nodes that forms the trie. It contains an Add method to put words into the dictionary and an isWord method which allows testing a string against the trie dictionary to see if it is a valid word. Remove is a method that is nice to have, but probably not necessary for your problem, so I haven't implemented it.
Option Compare Database
Option Explicit
Private m_Head As clsTrieNode
Private Sub Class_Initialize()
Set m_Head = New clsTrieNode
End Sub
Public Sub Add(strKey As String)
Dim currNode As clsTrieNode
Dim tempNode As clsTrieNode
Set currNode = m_Head
Dim strLCaseKey As String
strLCaseKey = LCase(strKey)
Dim i As Long
For i = 1 To Len(strLCaseKey)
If Not currNode.Child(Mid(strLCaseKey, i, 1)) Is Nothing Then
Set currNode = currNode.Child(Mid(strLCaseKey, i, 1))
Else
Exit For
End If
Next
For i = i To Len(strLCaseKey)
Set tempNode = New clsTrieNode
tempNode.KeyChar = Mid(strLCaseKey, i, 1)
Set currNode.Child(Mid(strLCaseKey, i, 1)) = tempNode
Set currNode = tempNode
Next
currNode.isWord = True
End Sub
Public Sub Remove(strKey As String)
'Might be nice to have
End Sub
Public Function isWord(strKey As String)
Dim currNode As clsTrieNode
Set currNode = m_Head
Dim strLCaseKey As String
strLCaseKey = LCase(strKey)
Dim i As Long
For i = 1 To Len(strLCaseKey)
If Not currNode.Child(Mid(strLCaseKey, i, 1)) Is Nothing Then
Set currNode = currNode.Child(Mid(strLCaseKey, i, 1))
Else
isWord = False
Exit Function
End If
Next
If currNode.isWord Then
isWord = True
Else
isWord = False
End If
End Function
Public Function getIterator() As clsTrieIterator
Dim oIterator As clsTrieIterator
Set oIterator = New clsTrieIterator
oIterator.Init m_Head
Set getIterator = oIterator
End Function
clsTrieIterator is a special class returned by clsTrie which allows parsing of a string to be done character by character with consumeChar instead of all at once as with clsTrie.isWord. This allows some freedom in parsing the string without backtracking or reading the same character more than once and it allows finding words when you are not sure how long they will be.
Option Compare Database
Option Explicit
Private m_currNode As clsTrieNode
Private m_currString As String
Public Property Get getCurrentString() As String
getCurrentString = m_currString
End Property
Public Sub Init(oNode As clsTrieNode)
Set m_currNode = oNode
End Sub
Public Function consumeChar(strChar As String) As Boolean
Dim strLCaseChar As String
strLCaseChar = LCase(strChar)
If Not m_currNode.Child(strLCaseChar) Is Nothing Then
consumeChar = True
Set m_currNode = m_currNode.Child(strLCaseChar)
m_currString = m_currString & strChar
Else
consumeChar = False
Set m_currNode = Nothing
End If
End Function
Public Function isWord() As Boolean
isWord = m_currNode.isWord
End Function
clsWordFinder puts everything together in a simple api tailored to your specific problem. It might be worth adding some logic to handle different behavior, like "greedy" matching vs "lazy" matching and overlapping vs nonoverlapping word parsing.
Option Compare Database
Option Explicit
Private m_Trie As clsTrie
Private Sub Class_Initialize()
Set m_Trie = New clsTrie
End Sub
Public Sub Add(strWord As String)
m_Trie.Add strWord
End Sub
Public Function getWordsFromString(strString As String) As String
Dim colIterators As Collection
Set colIterators = New Collection
Dim colMatches As Collection
Set colMatches = New Collection
Dim oIterator As clsTrieIterator
Dim strMatch As String
Dim i As Long
Dim iter
For i = 1 To Len(strString)
Set oIterator = m_Trie.getIterator
colIterators.Add oIterator, CStr(ObjPtr(oIterator))
For Each iter In colIterators
If Not iter.consumeChar(Mid(strString, i, 1)) Then
colIterators.Remove CStr(ObjPtr(iter))
ElseIf iter.isWord() Then
strMatch = iter.getCurrentString
Mid(strMatch, 1, 1) = UCase(Mid(strMatch, 1, 1))
colMatches.Add strMatch
colIterators.Remove CStr(ObjPtr(iter))
End If
Next
Next
getWordsFromString = JoinCollection(colMatches)
End Function
Public Function getWordsCollectionFromString(strString As String) As Collection
Dim colIterators As Collection
Set colIterators = New Collection
Dim colMatches As Collection
Set colMatches = New Collection
Dim oIterator As clsTrieIterator
Dim strMatch As String
Dim i As Long
Dim iter
For i = 1 To Len(strString)
Set oIterator = m_Trie.getIterator
colIterators.Add oIterator, CStr(ObjPtr(oIterator))
For Each iter In colIterators
If Not iter.consumeChar(Mid(strString, i, 1)) Then
colIterators.Remove CStr(ObjPtr(iter))
ElseIf iter.isWord() Then
strMatch = iter.getCurrentString
Mid(strMatch, 1, 1) = UCase(Mid(strMatch, 1, 1))
colMatches.Add strMatch
colIterators.Remove CStr(ObjPtr(iter))
End If
Next
Next
Set getWordsCollectionFromString = colMatches
End Function
Private Function JoinCollection(colStrings As Collection, Optional strDelimiter = " ") As String
Dim strOut As String
Dim i As Long
If colStrings.Count > 0 Then
strOut = colStrings.Item(1)
For i = 2 To colStrings.Count
strOut = strOut & strDelimiter & colStrings.Item(i)
Next
JoinCollection = strOut
End If
End Function

Extracting a Specific Variable from a Class Module in VBA to a Standard Module

All,
The following code is from Bloomberg. It is designed to extract bulk data from their servers. The code works, but I am trying to extract a specific variable generated in the class module and bring it to the Regular Module for user defined functions. Thanks for the help.
Option Explicit
Private WithEvents session As blpapicomLib2.session
Dim refdataservice As blpapicomLib2.Service
Private Sub Class_Initialize()
Set session = New blpapicomLib2.session
session.QueueEvents = True
session.Start
session.OpenService ("//blp/refdata")
Set refdataservice = session.GetService("//blp/refdata")
End Sub
Public Sub MakeRequest(sSecList As String)
Dim sFldList As Variant
Dim req As Request
Dim nRow As Long
sFldList = "CALL_SCHEDULE"
Set req = refdataservice.CreateRequest("ReferenceDataRequest") 'request type
req.GetElement("securities").AppendValue (sSecList) 'security + field as string array
req.GetElement("fields").AppendValue (sFldList) 'field as string var
Dim cid As blpapicomLib2.CorrelationId
Set cid = session.SendRequest(req)
End Sub
Public Sub session_ProcessEvent(ByVal obj As Object)
Dim eventObj As blpapicomLib2.Event
Set eventObj = obj
If Application.Ready Then
If eventObj.EventType = PARTIAL_RESPONSE Or eventObj.EventType = RESPONSE Then
Dim it As blpapicomLib2.MessageIterator
Set it = eventObj.CreateMessageIterator()
Do While it.Next()
Dim msg As Message
Set msg = it.Message
Dim Security As Element
Set Security = msg.GetElement("securityData").GetValue(0)
Sheet1.Cells(4, 4).Value = Security.GetElement("security").Value
Dim fieldArray As Element
Set fieldArray = Security.GetElement("fieldData")
Dim field As blpapicomLib2.Element
Set field = fieldArray.GetElement(0)
If field.DataType = 15 Then
Dim numBulkValues As Long
numBulkValues = field.NumValues '76
Dim index As Long
For index = 0 To numBulkValues - 1
Dim bulkElement As blpapicomLib2.Element
Set bulkElement = field.GetValue(index)
Dim numBulkElements As Integer
numBulkElements = bulkElement.NumElements '2 elements per each pt
ReDim Call_Sch(0 To numBulkValues - 1, 0 To numBulkElements - 1) As Variant
Dim ind2 As Long
For ind2 = 0 To numBulkElements - 1
Dim elem As blpapicomLib2.Element
Set elem = bulkElement.GetElement(ind2)
Call_Sch(index,ind2)=elem.Value
Sheet1.Cells(index + 4, ind2 + 5) = elem.Value
Next ind2
Next index
Else
Call_Sch(index,ind2)=field.Value
Sheet1.Cells(index + 4, ind2 + 5).Value = field.Value
End If
Loop
End If
End If
End Sub
The variable i am trying to get, specifically, is the Call_Sch. I want a function in the main module to recognize the variable. Thanks again.
It isn't necessary to declare a variable before using ReDim on it; ReDim can declare a variable. However, if you added:
Public Call_Sch() as Variant ' Insert correct data type here
then you would be able to refer to it via:
<YourClassVaraibleName>.Call_Sch

Resources