Object used for array, problem initializing

P

PeterBunde

New Member
Joined
Dec 7, 2016
Messages
45
Fellow sufferers

I am using an Object and the .Add function to store a two dimensional aray basically. The principle is illustrated in codebit 1 below which is working.

Now, I wish t do the
Code: 
Set .... = CreateObject("Scripting.Dictionary")
part separately, then later on in the code Ill do the actual value assignment. But that fails. My code is in codebit 2 below. It is the part
Code: 
review_status = CreateObject("Scripting.Dictionary")
which fails, error message 91 Object variable or With block variable not set.

How to make this Work?

Codebit 1:

Code: 
Sub Test()
Dim restaurant_serves_dish As Object
Set restaurant_serves_dish = CreateObject("Scripting.Dictionary")
' add countries
restaurant_serves_dish.Add "Ming Dynasty", CreateObject("Scripting.Dictionary")
restaurant_serves_dish.Add "Pepes Pizzaria", CreateObject("Scripting.Dictionary")
restaurant_serves_dish.Add "Uncle Sam Burgers", CreateObject("Scripting.Dictionary")
' add cities and number of inhabitants
restaurant_serves_dish("Ming Dynasty").Add "Pizza", 9
restaurant_serves_dish("France").Add "Paris", 200
restaurant_serves_dish("Italy").Add "Roma", 300
restaurant_serves_dish("Italy").Add "Milano", 400
restaurant_serves_dish("Italy").Add "Firenze", 500
restaurant_serves_dish("Italy").Add "Venezia", 600
' Show values
MsgBox _
    restaurant_serves_dish("Italy")("Venezia") & vbNewLine & _
    restaurant_serves_dish("France")("Paris") & vbNewLine & _
    restaurant_serves_dish("Norway")("Oslo")
    
End Sub

Codebit 2 (my actual code):

Code: 
Option Explicit
Dim reviewer_key(1 To 1000) As String
Dim reviewer_displayname(1 To 1000) As String
Public review_status As Object
Public Function reviewers(groupname As String)
httprequest = "[URL]https://csc-ejendom.atlassian.net/wiki/rest/api/group/[/URL]" & groupname & "/member"
Call RESTconnect
End Function
Private Function testitorrso()
Dim rev_group As String
Dim REVobjJSON, REVfirstJSON, REVresults, reviewer As Object
Dim reviewer_no As Integer
rev_group = Range("b1").Value()
windows_userinfo 'hent info fra LDAP om den bruger som er logget ind
    
Login.Show
Call reviewers(rev_group)
Set REVobjJSON = TestJSONParsingWithVBACallByName()
Set REVfirstJSON = GetObjectProperty(REVobjJSON, "results")
Dim length As Integer
length = GetProperty(REVfirstJSON, "length")
For reviewer_no = 1 To length
   Set reviewer = GetAtIndex(REVfirstJSON, reviewer_no - 1)
   
   Call register_reviewer(GetProperty(reviewer, "username"), GetProperty(reviewer, "displayName"))
Next reviewer_no
lineup_reviewers
End Function
Public Function register_reviewer(ByVal rev_key As String, ByVal rev_disp_name As String)
Dim pointer As Integer
pointer = 1
While reviewer_key(pointer) <> ""
    pointer = pointer + 1
Wend
reviewer_key(pointer) = rev_key
reviewer_displayname(pointer) = rev_disp_name
End Function
Public Function get_reviewer_displayname(keykey As String) As String
Dim pointer As Integer
pointer = 1
While reviewer_key(pointer) <> "" And reviewer_key(pointer) <> keykey
    pointer = pointer + 1
Wend
get_reviewer_displayname = reviewer_displayname(pointer)
End Function
Private Sub testing()
Call register_reviewer("Jan Magnussen", "jmus")
Call register_reviewer("Peter Jensen", "pjes")
Call register_reviewer("Ole Olsen", "oo")
Call register_reviewer("Fillo Fjedskuld", "ffsk")
MsgBox (get_reviewer_displayname("Jan Magnussenø"))
MsgBox (get_reviewer_displayname("Ole Olseno"))
MsgBox (get_reviewer_displayname("Fillo Fjedskuld"))
MsgBox (get_reviewer_displayname("Jan Magnussen"))
End Sub
Private Sub testarossa()
Dim nn, keykey, plussign, urliurli, reviewer  As String
Dim reviewer_of As Object
Dim Element As Variant
Set reviewer_of = CreateObject("Scripting.Dictionary")
    
    populate_reviewers
    lineup_reviewers
    nn = Range("G5").Value
keykey = deduct_key_from(nn)
Sheet_ ("Review (F1+F2)")
Row_() = 6
While Value_("Page URL") <> ""
    reviewer_of.Add Value_("Page URL"), CreateObject("Scripting.Dictionary")
    For Each Element In reviewer_key
        plussign = Value_(CStr(Element))
        If plussign = "+" Then
        urliurli = Value_("Page URL")
        reviewer = CStr(Element)
        reviewer_of(urliurli).Add reviewer, "REV"
    End If
    Next Element
    Row_() = Row_() + 1
Wend
MsgBox (reviewer_of("[URL]https://csc-ejendom.atlassian.net/wiki/pages/viewpage.action?pageId=88313417")("pbhansen[/URL]"))
MsgBox (reviewer_of("[URL]https://csc-ejendom.atlassian.net/wiki/pages/viewinfo.action?pageId=88646397")("nomennescio[/URL]"))
End Sub
Public Function populate_reviewers()
Dim rev_group As String
Dim REVobjJSON, REVfirstJSON, REVresults, reviewer As Object
Dim reviewer_no As Integer
rev_group = Range("b1").Value()
windows_userinfo 'hent info fra LDAP om den bruger som er logget ind
    
Login.Show
Call reviewers(rev_group)
Set REVobjJSON = TestJSONParsingWithVBACallByName()
Set REVfirstJSON = GetObjectProperty(REVobjJSON, "results")
Dim length As Integer
length = GetProperty(REVfirstJSON, "length")
For reviewer_no = 1 To length
   Set reviewer = GetAtIndex(REVfirstJSON, reviewer_no - 1)
   
   Call register_reviewer(GetProperty(reviewer, "username"), GetProperty(reviewer, "displayName"))
Next reviewer_no
lineup_reviewers
End Function
Public Function lineup_reviewers()
Dim pointer, reviewer_no As Integer
pointer = 1
While reviewer_key(pointer) <> ""
Call insert_reviewer(pointer)
    pointer = pointer + 1
Wend
End Function
Private Function insert_reviewer(ByVal nono As Integer)
Dim offset As Integer
offset = (nono - 1) * 13
Sheet_ ("Review (F1+F2)")
Value_(9, 2, offset) = reviewer_displayname(nono) & "                    " & reviewer_key(nono)
End Function
Private Function deduct_key_from(ByVal tenspacesep As String) As String
Dim pos_separator As Integer
pos_separator = Len(tenspacesep) - InStr(tenspacesep, "          ") - 19
deduct_key_from = Right(tenspacesep, pos_separator)
End Function
Sub testarooosa()
MsgBox (deduct_key_from("Britta Schall Holberg                    nomennescio"))
End Sub
Sub Test()
Dim restaurant_serves_dish As Object
Set restaurant_serves_dish = CreateObject("Scripting.Dictionary")
' add countries
restaurant_serves_dish.Add "Ming Dynasty", CreateObject("Scripting.Dictionary")
restaurant_serves_dish.Add "Pepes Pizzaria", CreateObject("Scripting.Dictionary")
restaurant_serves_dish.Add "Uncle Sam Burgers", CreateObject("Scripting.Dictionary")
' add cities and number of inhabitants
restaurant_serves_dish("Ming Dynasty").Add "Pizza", 9
restaurant_serves_dish("France").Add "Paris", 200
restaurant_serves_dish("Italy").Add "Roma", 300
restaurant_serves_dish("Italy").Add "Milano", 400
restaurant_serves_dish("Italy").Add "Firenze", 500
restaurant_serves_dish("Italy").Add "Venezia", 600
' Show values
MsgBox _
    restaurant_serves_dish("Italy")("Venezia") & vbNewLine & _
    restaurant_serves_dish("France")("Paris") & vbNewLine & _
    restaurant_serves_dish("Norway")("Oslo")
    
End Sub
Private Sub testarossa_()
Dim nn, keykey, plussign, urliurli, reviewer  As String
Dim review_status, review_kommentar As Object
Dim Element As Variant
Set review_status = CreateObject("Scripting.Dictionary")
Set review_kommentar = CreateObject("Scripting.Dictionary")

review_status.Add "Teststrategi", CreateObject("Scripting.Dictionary")
review_kommentar.Add "Teststrategi", CreateObject("Scripting.Dictionary")
        review_status("Teststrategi").Add "Ole Olsen", "Rejected"
        review_kommentar("Teststrategi").Add "Ole Olsen", "It does not work!"
MsgBox (review_status("Teststrategi")("Ole Olsen") & " : " & review_kommentar("Teststrategi")("Ole Olsen"))
'MsgBox (review_status("Teststrategi")("Bente Lindgren")
End Sub
Public Function update_review_status(urliz As String, reviewerz As String, statuz As String)
review_status(urliz).Add reviewerz, reg, statuz
End Function
Public Function load_reviewmatrix()
Dim URL_no, sheet_line, reviewer_no As Integer
Dim urli, reviewer As String
Dim sheet_column As Integer
Dim review As Object
Dim offset As Integer
Set review = CreateObject("Scripting.Dictionary")
Sheet_ ("Review (F1+F2)")
For URL_no = 1 To 20
    Row_() = 3 + 4 * (URL_no - 1)
    urli = Value_("Page URL")
    
    If urli <> "" Then
        review.Add urli, CreateObject("Scripting.Dictionary")
        For reviewer_no = 1 To 17
        
            offset = (reviewer_no - 1) * 13
    
            reviewer = Cells(2, 9 + offset).Value()
            
            If reviewer <> "" Then
                reviewer = deduct_key_from(reviewer)
    
                If reviewer <> "" Then
    
                    'Call review_matrix(urli, reviewer, )
    
                    If Value_(9 + offset) & Value_(10 + offset) & Value_(11 + offset) <> "" Then
                        review(urli).Add reviewer, "Assigned"
                        
                    Else
                    
                        review(urli).Add reviewer, "UNassigned"
                    End If
        
                End If
                
            End If
            
        Next reviewer_no
    End If
Next URL_no
MsgBox (review("[URL]https://csc-ejendom.atlassian.net/wiki/spaces/YR/pages/86510090/Testdrejebog+-+Delleverance+Pr+ve+1")("pbhansen[/URL]"))
End Function
Public Function init_review_status()
review_status = CreateObject("Scripting.Dictionary")
End Function
Public Sub register_page_for_review(pageurli As String)
review_status.Add pageurli, CreateObject("Scripting.Dictionary")
End Sub
Public Function clear_review_matrix()
Sheet_ ("Review (F1+F2)")
For revno = 1 To 17
    reviewer_displayname(revno) = ""
    Call insert_reviewer(revno)
Next revno

End Function
Public Function markup_updated_review_status()
Private statustext As String
Sheet_ ("Review (F1+F2)")
For URL_no = 1 To 20
    Row_() = 3 + 4 * (URL_no - 1)
    urli = Value_("Page URL")
    
    If urli <> "" Then
            
            For reviewer_no = 1 To 17
        
                offset = (reviewer_no - 1) * 13
    
                reviewer = Cells(2, 9 + offset).Value()
            
                If reviewer <> "" Then
                
                    statustext = "Unassigned"
                
                    Call get_status_of_review(urli, reviewer, statustext)
                    
                    Call mark_status(statustext, Row_(), 9 + offset)
                
                End If
            
            Next reviewer_no
    
    End If
Next URL_no
End Function
Private Function get_status_of_review(urliø As String, reviewerø As String, ByVal statustextø As String)
'Is the review scheduled at all?
statustextø = "Unassigned"
If review(urliø)(reviewerø) = "Assigned" Then
'If the review is scheduled, is there a progress status available? AFVIST or GODKENDT
    If review_status(urliø)(reviewerø) <> "" Then
        statustextø = review_status(urliø)(reviewerø)
    End If
End If
End Function
Public Function mark_status(status_to_mark As String, rowski As Integer, colski As Integer)
Application.EnableEvents = False
Select Case status_to_mark
    Case "AFVIST"
    
        Cells(rowski, colski + 1) = "="
    
    Case "GODKENDT"
    
        Cells(rowski, colski + 2) = "ü"
End Select
Application.EnableEvents = True
End Function

Private Function load_reviewmatrix_()
Dim URL_no, sheet_line, reviewer_no As Integer
Dim urli, reviewer As String
Dim sheet_column As Integer
Dim review As Object
Dim offset As Integer
Set review = CreateObject("Scripting.Dictionary")
Sheet_ ("Review (F1+F2)")
For URL_no = 1 To 20
    Row_() = 3 + 4 * (URL_no - 1)
    urli = Value_("Page URL")
    
    If urli <> "" Then
        review.Add urli, CreateObject("Scripting.Dictionary")
        For reviewer_no = 1 To 17
        
            offset = (reviewer_no - 1) * 13
    
            reviewer = Cells(2, 9 + offset).Value()
            
            If reviewer <> "" Then
                reviewer = deduct_key_from(reviewer)
    
                If reviewer <> "" Then
    
                    'Call review_matrix(urli, reviewer, )
    
                    If Value_(9 + offset) & Value_(10 + offset) & Value_(11 + offset) <> "" Then
                        review(urli).Add reviewer, "Assigned"
                        
                    Else
                    
                        review(urli).Add reviewer, "UNassigned"
                    End If
        
                End If
                
            End If
            
        Next reviewer_no
    End If
Next URL_no
MsgBox (review("[URL]https://csc-ejendom.atlassian.net/wiki/spaces/YR/pages/86510090/Testdrejebog+-+Delleverance+Pr+ve+1")("pbhansen[/URL]"))
End Function
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Sort by date Sort by votes
You must log in or register to reply here.

Similar threads

G
  • Solved
run VBA when clicked
Replies
4
Views
116
Gylle
G
E
  • Question Question
Function to return array of 10 largest absolute values while maintaining sign
Replies
3
Views
557
eurobonds
E
H
  • Question Question
VBA split file based and send splitted file in separate emails
Replies
0
Views
706
harmless92
H
Jaafar Tribak
  • Question Question
Blurring images using Direct2D & Windows Imaging Component
Replies
3
Views
788
Dan_W
D
I
  • Question Question
Modify VBA script to count rows with data in multiple sheets
Replies
0
Views
404
irishjsk
I

Forum statistics

Threads
1,223,911
Messages
6,175,329
Members
452,635
Latest member
laura12345

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top