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
 

Some videos you may like

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

DataBlake

Well-known Member
Joined
Jan 26, 2015
Messages
781
Office Version
  1. 2016
Platform
  1. Windows
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:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,546
Office Version
  1. 365
Platform
  1. Windows
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
 

DataBlake

Well-known Member
Joined
Jan 26, 2015
Messages
781
Office Version
  1. 2016
Platform
  1. Windows
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:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,546
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

As you have a one line If statement, you don't use End If so delete it.
 

DataBlake

Well-known Member
Joined
Jan 26, 2015
Messages
781
Office Version
  1. 2016
Platform
  1. Windows
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?
 

DataBlake

Well-known Member
Joined
Jan 26, 2015
Messages
781
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

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
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,546
Office Version
  1. 365
Platform
  1. Windows
I hadn't realised quite what you were doing.
Are you the only person who will be using this?
 

DataBlake

Well-known Member
Joined
Jan 26, 2015
Messages
781
Office Version
  1. 2016
Platform
  1. Windows
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:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,546
Office Version
  1. 365
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,109,395
Messages
5,528,487
Members
409,820
Latest member
gabrielrms

This Week's Hot Topics

  • Change military grades into rank
    Afternoon all Need help with formula that will change military rank (i.e. 1, 2, 3 into Amn, A1C, SrA). Running IF formula that does not work...
  • VBA COUNTIF SOLUTION
    Hi The following are the errors spread across the several columns from E to Q ie. 13 columns across several sheets with more than 500 rows per...
  • INSERT ROW WITH SPECIFIS TEXT IN A COLUMN
    Hi All! How can identify that that the row to be inserted has to be inserted before 1st row with specific text in column F. If I record the...
  • Auto-Create a monthly Sign in sheet for preschool students
    The image below is what each page looks like. Above is space for the "Child Name" "Month" "Class" School days are obviously Monday-Friday but...
  • VBA vlookup multiple results
    Hi folks, Hopefully someone out there can help. I have a list to vlookup which works (ish). the lookup only picks up the first instance of the...
  • Extract values for earliest/latest times
    I am trying to put together a formula to get the earliest start time, the latest end time from column A for each person in Column B-F without the...
Top