Personal Workbook Macro Punlic Dictionary Set Up [vba]

DataBlake

Well-known Member
Joined
Jan 26, 2015
Messages
781
Office Version
  1. 2016
Platform
  1. Windows
I want to create some dictionaries that i can access in any workbook.
I.E a list of colors as the key and a list of shortened versions of that color.

Gloss Black White Trim = key
Black = Value

i have a sheet with these values that i would like to establish as a disctionary
A: will this work if i set this vba code publicly dim the dictionary object in my personal workbook?
B: i'm pretty new to setting up dictionaries so how can i convert a sheet *key in Column A, value in Column B* to a dictionary effectively?
C: if possible is this something i can keep updated?

the plan is i open a vendor's data sheet and they have weird color names or other similar problem and instead of doing a 60,000 item vlookup i could just use arrays and dictionaries to change values in the sheet with a vba sub
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
so i created a sub that is giving me Run-time error '1004' Application-defined or object-defined error

Code:
Sub Workbook_Open()
Sheets("Finish Filter").Visible = True
Sheets("Finish Filter").Select
Application.Run "PERSONAL.XLSB!dictionarySHORT"
Application.Run "Personal.xlsb!dictionaryFINISH"
Sheets("Program Start").Select
Sheets("Finish Filter").Visible = False

End Sub

it is intended to unhide the sheet finish filter, assign its values to dictionaries, and then hide the sheet again.
its hanging up on the Application.Run lines
here is the sub in the XLSB i'm trying to get to work

Code:
Public dicIMG As Object
Public dicFINISH As Object
Public dicSHORT As Object
Public dicBP As Object
Public ary1 As Variant
Public ary2 As Variant
Public i As Long

Sub DictionaryFINISH()

'establish sheet arrays and dictionary object
Dim ws As ActiveSheet

  ary1 = .Range("A1").CurrentRegion.Value2
  Set dicFINISH = CreateObject("scripting.dictionary")

'add image by part number to dictionary
With ws
    For i = 2 To UBound(ary1)
        If Not dicFINISH.exists(ary(i, 1)) Then dicFINISH.Add ary1(i, 1), ary1(i, 2)
    Next i
    End If
End With
End Sub
 
Last edited:
Upvote 0
You shouldn't have a . infront of range on this line as it's not inside a With statement
Code:
 ary1 = .Range("A1").CurrentRegion.Value2
 
Upvote 0
You shouldn't have a . infront of range on this line
ah.
i also caught that ary was not defined so i changed it to ary1
but now im getting an End if without block if error on


Code:
Sub DictionarySHORT()

'establish sheet arrays and dictionary object
Dim ws As Worksheet
Set ws = ActiveSheet
With ws
  ary1 = .Range("A1").CurrentRegion.Value2
  Set dicSHORT = CreateObject("scripting.dictionary")

'add image by part number to dictionary

    For i = 2 To UBound(ary1)
        If Not dicSHORT.exists(ary1(i, 1)) Then dicSHORT.Add ary1(i, 1), ary1(i, 3)
    Next i
    End If
End With
End Sub
 
Last edited:
Upvote 0
As you have a one line If statement, you don't use End If so delete it.
 
Upvote 0
As you have a one line If statement, you don't use End If so delete it.

oh neat. i had no idea that was a thing. must've never used one line if statements.
i don't get any error codes now, time to test.
do you think this is an okay way of keeping a dictionary refreshed?
 
Upvote 0
Okay so after the dictionaries are created do i have to call them via application.run as well? how would i call the dictionary object as opposed to the macro?
i'm getting error 424: object required on this line where i'm assigning the dictionary value to (highlighted red)

Code:
Sub aanewWPcode()
    Dim ary As Variant
    Dim i As Long
    Dim lastRow As Long
    

With ActiveSheet

' assign two arrays; one for reference and one for printing values
ary = .Range("A1").CurrentRegion.Value2
ary2 = .Range("A1").CurrentRegion.Value2

' transfer correct data to proper columns using the two arrays
For i = 2 To UBound(ary)
ary2(i, 1) = ary(i, 2)
ary2(i, 2) = ary(i, 38)
ary2(i, 3) = ary(i, 41)
ary2(i, 4) = ary(i, 69)
ary2(i, 5) = ary(i, 8)
ary2(i, 6) = ary(i, 9)
ary2(i, 7) = ary(i, 4)
ary2(i, 8) = ary(i, 13)
ary2(i, 9) = ary(i, 14)
ary2(i, 10) = ary(i, 11)
ary2(i, 11) = ary(i, 12)

' if statement for determing map or retail pricing
If ary(i, 7) > 0 Then
ary2(i, 12) = ary(i, 7)
ElseIf ary(i, 6) > 0 Then
ary2(i, 12) = ary(i, 6)
Else
ary2(i, 12) = "err"
End If

ary2(i, 13) = ary(i, 19)
ary2(i, 14) = ary(i, 36)

'do lookups using pre established dictionaries
[B][COLOR=#ff0000]ary2(i, 15) = dicIMG.Item(ary2(i, 1))
ary2(i, 4) = dicFINISH.Item(ary2(i, 4))[/COLOR][/B]

ary2(i, 16) = "title"
ary2(i, 17) = "desc"
ary2(i, 18) = "qty"
ary2(i, 19) = ary(i, 15)
Next i

Cells.Delete

' print the array to the sheet
.Range("A1").Resize(UBound(ary2), 19).Value = ary2
End With



End Sub
 
Upvote 0
I hadn't realised quite what you were doing.
Are you the only person who will be using this?
 
Upvote 0
Are you the only person who will be using this?

for now yes.
i can re clarify:

I have a workbook i open
it should update the dictionaries for images, colors, color shortcode, etc
these dictionaries should be accessible and passable to any workbook i open

so the only code i have in my XLSB is
Code:
Public dicIMG As Object
Public dicFINISH As Object
Public dicSHORT As Object
Public dicBP As Object
Public ary1 As Variant
Public ary2 As Variant
Public i As Long

[B][COLOR=#ff0000]Sub DictionaryIMG()

'establish sheet arrays and dictionary object
Dim ws As Worksheet
Set ws = ActiveSheet
With ws

  ary1 = .Range("A1").CurrentRegion.Value2
  Set dicIMG = CreateObject("scripting.dictionary")

'add image by part number to dictionary

    For i = 2 To UBound(ary1)
        If Not dicIMG.exists(ary1(i, 1)) Then dicIMG.Add ary1(i, 1), ary1(i, 5)
    Next i
End With
End Sub[/COLOR][/B]

Sub DictionarySHORT()

'establish sheet arrays and dictionary object
Dim ws As Worksheet
Set ws = ActiveSheet
With ws

  ary1 = .Range("A1").CurrentRegion.Value2
  Set dicSHORT = CreateObject("scripting.dictionary")

'add image by part number to dictionary

    For i = 2 To UBound(ary1)
        If Not dicSHORT.exists(ary1(i, 1)) Then dicSHORT.Add ary1(i, 1), ary1(i, 3)
    Next i
End With
End Sub

[B][COLOR=#ff0000]Sub DictionaryFINISH()

'establish sheet arrays and dictionary object
Dim ws As Worksheet
Set ws = ActiveSheet
With ws

  ary1 = .Range("A1").CurrentRegion.Value2
  Set dicFINISH = CreateObject("scripting.dictionary")

'add image by part number to dictionary

    For i = 2 To UBound(ary1)
        If Not dicFINISH.exists(ary1(i, 1)) Then dicFINISH.Add ary1(i, 1), ary1(i, 2)
    Next i
End With
End Sub[/COLOR][/B]


Sub DictionaryBP()

'establish sheet arrays and dictionary object
Dim ws As Worksheet
Set ws = ActiveSheet
With ws

  ary1 = .Range("A1").CurrentRegion.Value2
  Set dicBP = CreateObject("scripting.dictionary")

'add image by part number to dictionary

    For i = 2 To UBound(ary1)
        If Not dicBP.exists(ary1(i, 1)) Then dicBP.Add ary1(i, 1), ary1(i, 2)
    Next i
End With
End Sub

so i call these XLSB subs and update them via workbook open code in my XLSM workbook
which i feel i should either put this in the XLSB instead or this is where the variables should be passed as well, but i don't know how to do that

Code:
Sub Workbook_Open()

'Update Finish Color Dictionary
Sheets("Finish Filter").Visible = True
Sheets("Finish Filter").Select
Application.Run "PERSONAL.XLSB!dictionarySHORT"
[B][COLOR=#ff0000]Application.Run "Personal.xlsb!dictionaryFINISH"[/COLOR][/B]
Sheets("Program Start").Select
Sheets("Finish Filter").Visible = False

'Update Image Disctionary
Sheets("Master Image").Visible = True
Sheets("Master Image").Select
[B][COLOR=#ff0000]Application.Run "PERSONAL.XLSB!dictionaryIMG"[/COLOR][/B]
Sheets("Program Start").Select
Sheets("Master Image").Visible = False

End Sub

then in that same XLSM i have a code that interacts with vendor data using the dictionaries

Code:
Sub aanewWPcode()
    Dim ary As Variant
    Dim ary2 As Variant
    Dim i As Long
    Dim lastRow As Long
    

With ActiveSheet

' assign two arrays; one for reference and one for printing values
ary = .Range("A1").CurrentRegion.Value2
ary2 = .Range("A1").CurrentRegion.Value2

' transfer correct data to proper columns using the two arrays
For i = 2 To UBound(ary)
ary2(i, 1) = ary(i, 2)
ary2(i, 2) = ary(i, 38)
ary2(i, 3) = ary(i, 41)
ary2(i, 4) = ary(i, 69)
ary2(i, 5) = ary(i, 8)
ary2(i, 6) = ary(i, 9)
ary2(i, 7) = ary(i, 4)
ary2(i, 8) = ary(i, 13)
ary2(i, 9) = ary(i, 14)
ary2(i, 10) = ary(i, 11)
ary2(i, 11) = ary(i, 12)

' if statement for determing map or retail pricing
If ary(i, 7) > 0 Then
ary2(i, 12) = ary(i, 7)
ElseIf ary(i, 6) > 0 Then
ary2(i, 12) = ary(i, 6)
Else
ary2(i, 12) = "err"
End If

ary2(i, 13) = ary(i, 19)
ary2(i, 14) = ary(i, 36)

'do lookups using pre established dictionaries
[B][COLOR=#ff0000]ary2(i, 15) = dicIMG.Item (ary2(i, 1))
ary2(i, 4) = dicFINISH.Item(ary2(i, 4))[/COLOR][/B]

ary2(i, 16) = "title"
ary2(i, 17) = "desc"
ary2(i, 18) = "qty"
ary2(i, 19) = ary(i, 15)
Next i

Cells.Delete

' print the array to the sheet
.Range("A1").Resize(UBound(ary2), 19).Value = ary2
End With



End Sub

and thats where we currently are.
 
Last edited:
Upvote 0
If this is ultimately going to be used by other people, I'd put all the relevant code in the workbook it relates to.
Also if you open Book1 the dictionaries will be populated, but if you then open Book2 it will erase what's in the dictionaries & replace it with something else, so you can no longer use the code with book1 except by closing Book1 & then re-opening it.
Which in turn means that you cannot then use the code with Book2
 
Upvote 0

Forum statistics

Threads
1,224,824
Messages
6,181,187
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

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