Python dictionary in VBA

[Einsener37]

Hi!
I made one simple python code for myself.
Principal is:
1) it asks user for real number input between 0.1 to 129.99
2) it compares this number with conditions and runs through a "dictionary"
3) finds proper results and adds them to new dictionary and prints them out
Now I'm trying to run this same thing in Excel with VBA.
Is there a way in VBA to create dictionary and use it in the same way as in python?
Or how should i make it in VBA?
Thanks!
Martin


import math
crosssection= float(input("Rebar cross-section value(cm2):"))
rebars={######1 rebar
'0.28':'1x6','0.50':'1x8','0.79':'1x10','1.13':'1x12', '1.54':'1x14','2.01':'1x16','2.54':'1x18',\
'3.14':'1x20','3.80':'1x22','4.91':'1x25','6.16':'1x28','8.04':'1x32','10.1 8':'1x36','12.570':'1x40',\
##### 2 rebars
'0.57':'2x6','1.01':'2x8','1.57':'2x10','2.26':'2x12','3.08':'2x14','4.02': '2x16','5.09':'2x18','6.28':'2x20','7.60':'2x22','9.82':'2x25',\
'12.32':'2x28','16.08':'2x32','20.36':'2x36','25.13':'2x40',\
##### 3 rebars
'0.85':'3x6','1.51':'3x8','2.36':'3x10','3.39':'3x12','4.62':'3x14',\
'6.03':'3x16','7.63':'3x18','9.42':'3x20','11.40':'3x22','14.73':'3x25','18 .47':'3x28','24.13':'3x32','30.54':'3x36','37.70':'3x40',\
###### 4 rebars
'1.13':'4x6','2.01':'4x8','3.14':'4x10','4.52':'4x12','6.16':'4x14','8.04': '4x16','10.18':'4x18','12.57':'4x20','15.21':'4x22',\
'19.63':'4x25','24.63':'4x28','32.17':'4x32','40.72':'4x36','50.27':'4x40', \
###### 5 rebars
'1.41':'5x6','2.51':'5x8','3.93':'5x10','5.65':'5x12','7.70':'5x14','10.05' :'5x16','12.72':'5x18','15.71':'5x20','19.01':'5x22',\
'24.54':'5x25','30.79':'5x28','40.21':'5x32','50.89':'5x36','62.83':'5x40', \
###### 6 rebars
'1.70':'6x6','3.02':'6x8','4.71':'6x10','6.79':'6x12','9.24':'6x14','12.06' :'6x16','15.27':'6x18','18.85':'6x20','22.81':'6x22',\
'29.45':'6x25','36.95':'6x28','48.25':'6x32','61.07':'6x36','75.40':'6x40', \
###### 7 rebars
'1.98':'7x6','3.52':'7x8','5.50':'7x10','7.92':'7x12','10.78':'7x14','14.07 ':'7x16','17.81':'7x18','21.99':'7x20','26.61':'7x22',\
'34.36':'7x25','43.10':'7x28','56.30':'7x32','71.25':'87.96',\
##### 8 rebars
'2.26':'8x6','4.02':'8x8','6.28':'8x10','9.05':'8x12','12.32':'8x14','16.08 ':'8x16','20.36':'8x18','25.13':'8x20','30.41':'8x22',\
'39.27':'8x25','49.26':'8x28','64.34':'8x32','81.43':'8x36','100.53':'8x40' ,\
##### 9 rebars
'2.54':'9x6','4.52':'9x8','7.07':'9x10','10.18':'9x12','13.85':'9x14','18.1 0':'9x16','22.90':'9x18','28.27':'9x20','34.21':'9x22',\
'44.18':'9x25','55.42':'9x28','72.38':'9x32','91.61':'9x36','113.10':'9x40' ,\
#### 10 rebars
'2.83':'10x6','5.03':'10x8','7.85':'10x10','11.31':'10x12','15.39':'10x14', '20.11':'10x16','25.45':'10x18','31.42':'10x20','38.01':'10x22',\
'49.09':'10x25','61.58':'10x28','80.42':'10x32','101.79':'10x36','125.66':' 10x40'}

result={}


def smalestClosest(input):
for smalest in rebars:
if float(smalest)<input and float(smalest)>math.floor(input):
result[smalest]=rebars[smalest]
return

if crosssection>0 and crosssection<130:
smalestClosest(crosssection)
for closestRebar in rebars:
if crosssection<=float(closestRebar)<math.ceil(float(crosssection+2)):
result[closestRebar]=rebars[closestRebar]
else:
print("Rebars not available. Check input")
print("Rebar results:")
for t in result:
print(t,result[t])

[JKwan]

see if this works.... I don't know python so i use ChatGPT to convert your program:
you will also need to add the rest of your measurements to the Dictionary as well
you need to add a reference to Microsoft Scripting Runtime as well


Sub RebarResults()
Dim crosssection As Single
crosssection = InputBox("Rebar cross-section value(cm2):")

Dim rebars As Scripting.Dictionary
Set rebars = New Scripting.Dictionary

' 1 rebars
rebars.Add 0.28, "1x6"
rebars.Add 0.5, "1x8"
rebars.Add 0.79, "1x10"
rebars.Add 1.13, "1x12"
rebars.Add 1.54, "1x14"
rebars.Add 2.01, "1x16"
rebars.Add 2.54, "1x18"
rebars.Add 3.14, "1x20"
rebars.Add 3.8, "1x22"
rebars.Add 4.91, "1x25"
rebars.Add 6.16, "1x28"
rebars.Add 8.04, "1x32"
rebars.Add 10.18, "1x36"
rebars.Add 12.57, "1x40"

' 2 rebars
rebars.Add 0.57, "2x6"
rebars.Add 1.01, "2x8"
rebars.Add 1.57, "2x10"
rebars.Add 2.26, "2x12"
rebars.Add 3.08, "2x14"
rebars.Add 4.02, "2x16"
rebars.Add 5.09, "2x18"
rebars.Add 6.28, "2x20"
rebars.Add 7.60, "2x22"
rebars.Add 9.82, "2x25"
rebars.Add 12.32, "2x28"
rebars.Add 16.08, "2x32"
rebars.Add 20.36, "2x36"
rebars.Add 25.13, "2x40"

' 3 rebars
rebars.Add 0.85, "3x6"
rebars.Add 1.51, "3x8"
rebars.Add 2.36, "3x10"
rebars.Add 3.39, "3x12"
rebars.Add 4.62, "3x14"
rebars.Add 6.03, "3x16"
rebars.Add 7.63, "3x18"
rebars.Add 9.42, "3x20"
rebars.Add 11.40, "3x22"
rebars.Add 14.73, "3x25"
rebars.Add 18.47, "3x28"
rebars.Add 24.13, "3x32"
rebars.Add 30.54, "3x36"
rebars.Add 37.70, "3x40"

Dim result As Scripting.Dictionary
Set result = New Scripting.Dictionary

' Find the smallest closest rebar size
For Each smalest In rebars
If smalest < crosssection And smalest > Fix(crosssection) Then
result.Add smalest, rebars(smalest)
End If
Next smalest

' Find the closest rebar size
For Each closestRebar In rebars
If crosssection <= closestRebar And closestRebar < Round(crosssection + 2, 0) Then
result.Add closestRebar, rebars(closestRebar)
End If
Next closestRebar

' Print the results
If result.Count > 0 Then
MsgBox "Rebar results:" & vbCrLf & Join(result.Items, vbCrLf)
Else
MsgBox "Rebars not available. Check input"
End If
End Sub

[Einsener37]

Thank you!
That seems to work in a way.
Did ChatGBT did all that? Wow
If I may ask, what does this part " vbCrLf" of the code means?

MsgBox "Rebar results:" & vbCrLf & Join(result.Items, vbCrLf)

[Aussiebear]

Carriage Return Line Feed

[JKwan]

Yes, chatgpt did all that

[p45cal]

That seems to work in a way.
I don't know python either, but in the definition of the function smalestClosest does the first time the conditions are met cause the code to jump out of the for loop? or does the function keep looping and possibly add several results to the new dictionary?

[JKwan]

from the run that I did, multiple values are displayed when you enter a value to search

[p45cal]

from the run that I did, multiple values are displayed when you enter a value to search

Well, was that the vba version you were running? It doesn't jump out of the loop on conditions being met. Anyway, there's additional confusion added by the second loop also adding to the results. So I was trying to ascertain what happens in just the python function smalestClosest.

[JKwan]

yes, i was running the VBA version. I don't have Python.

[Einsener37]

If I'd like to modify it a bit.
I would like both key word and key item(value) be in the output
For ex.:
12.32:2x28 or similar to that
How should i modify it?

[p45cal]

Would you mind answering my query in msg#8?
It's as if I'm invisible, or my question is a stupid one.

[Einsener37]

Would you mind answering my query in msg#8?
It's as if I'm invisible, or my question is a stupid one.
Sorry,
Could you explain that a bit more in detail? Cause i didn't quite undestand

[JKwan]

if the VBA is correct, below is the modification:

' Find the smallest closest rebar size
For Each smalest In rebars
If smalest < crosssection And smalest > Fix(crosssection) Then
result.Add smalest, smalest & " - " & rebars(smalest)
End If
Next smalest

' Find the closest rebar size
For Each closestRebar In rebars
If crosssection <= closestRebar And closestRebar < Round(crosssection + 2, 0) Then
result.Add closestRebar, closestRebar & " - " & rebars(closestRebar)
End If
Next closestRebar

' Print the results
If result.Count > 0 Then
MsgBox "Rebar results: " & crosssection & vbCrLf & Join(result.Items, vbCrLf)
Else
MsgBox "Rebars not available. Check input: " & crosssection
End If

[Einsener37]

Thank you!
Works

[Aussiebear]

If you are satisfied with the responses received, please use the thread tools option to mark the thread as Solved.

[p45cal]

Sorry,
Could you explain that a bit more in detail? Cause i didn't quite undestandin the function definition:

def smalestClosest(input):
for smalest in rebars:
if float(smalest)<input and float(smalest)>math.floor(input):
result[smalest]=rebars[smalest]
returnwhen the if is true, does the for loop stop looping, or does it continue looping?
I thought you'd be able to tell me since you wrote it.

[JKwan]

My thinking is yes until all rebars are done

[Einsener37]

in the function definition:

def smalestClosest(input):
for smalest in rebars:
if float(smalest)<input and float(smalest)>math.floor(input):
result[smalest]=rebars[smalest]
returnwhen the if is true, does the for loop stop looping, or does it continue looping?
I thought you'd be able to tell me since you wrote it.

Yes, it continues looping through all dictionary
But if I add return inside IFt statement , then it will stop if correct match is found.


def smalestClosest(input):
for smalest in rebars:
if float(smalest)<=input and float(smalest)>=math.floor(input):
result[smalest]=rebars[smalest]
return
return

[Einsener37]

I'm trying to modify this code a bit.
I would like to use listbox for the "result", so i could choose one option from result and display it in excel cell/range.
As I understand i have to create userForm and add listbox inside that?
How do i get results inside this listbox and the chosen option in the excel cell?
Thanks in advance

[JKwan]

here you go. I did not use a form, I just put a control onto the sheet

[Einsener37]

If it's not too much trouble.
Could you describe step by step, how to do it.
Because my excel doesn't let to run your macro file
Thanks!

[JKwan]

what version of excel do you have?

[JKwan]

i resave the file to 97-2003 format

[Einsener37]

Sry, my bad. It opened

[Einsener37]

On thing happened!
When I added some more rebars to Dictionary, it gave me error, because there is already with same key word element
For ex.


' 1 rebars
rebars.Add 0.28, "1x6"
rebars.Add 0.5, "1x8"
rebars.Add 0.79, "1x10"
rebars.Add 1.13, "1x12"
rebars.Add 1.54, "1x14"
rebars.Add 2.01, "1x16"
rebars.Add 2.54, "1x18"
rebars.Add 3.14, "1x20"
rebars.Add 3.8, "1x22"
rebars.Add 4.91, "1x25"
rebars.Add 6.16, "1x28"
rebars.Add 8.04, "1x32"
rebars.Add 10.18, "1x36"
rebars.Add 12.57, "1x40"

' 4 rebars
rebars.Add 1.13, "4x6"
rebars.Add 2.01, "4x8"
rebars.Add 3.14, "4x10"
rebars.Add 4.52, "4x12"
rebars.Add 6.16, "4x14"
rebars.Add 8.04, "4x16"
rebars.Add 10.18, "4x18"
rebars.Add 12.57, "4x20"
rebars.Add 15.21, "4x22"
rebars.Add 19.63, "4x25"
rebars.Add 24.63, "4x28"
rebars.Add 32.17, "4x32"
rebars.Add 40.72, "4x36"
rebars.Add 50.27, "4x40"


How could i fix it in VBA? Perhaps i have to use extra dictionary, ex. rebars2?

[Einsener37]

Okei i did it as i did in Python
I used String type for key word and I added 0 to the end, example 3.140 and converted string to long so i could compare
But it doesn't help.
I use function CLng, and i rounds it as it wishes and my if statements won't work anymore

[p45cal]

Perhaps use the '4x28' as the key as they are unique and the numbers as the items?

[Einsener37]

Perhaps use the '4x28' as the key as they are unique and the numbers as the items?
Muchos grazies, that might work

[Einsener37]

here you go. I did not use a form, I just put a control onto the sheet
Could you help me more.
If you run your macro and enter the value, which is already in rebars dictionary , ex 1.57. Then it will give such error
How should code be changed for not to get such error massage?
Thanks!
30644

[p45cal]

See attached.
BTW:
30645

[Aussiebear]

Since this thread is apparently not solved I shall remove the "Solved" entitlement

[Einsener37]

See attached.
BTW:
30645
Thank you!
It works :)

[Aussiebear]

Then mark the thread as solved Einsener 37.

[Einsener37]

See attached.
BTW:
30645

Could you help me to modify it a bit.
How does it work with VBA if i want to split the result into different sells? Ex, cross-area, pcs and diameter in different cells.
30654

[p45cal]

Attached.

[Einsener37]

Just to understand more
Where have you defined these variables xx, yy, zz?
30657

[p45cal]

I haven't.
I took out Option Explicit.
If you must define them:
Dim xx,yy,zz
in the same Listbox_Click sub.

[Einsener37]

I haven't.
I took out Option Explicit.
If you must define them:
Dim xx,yy,zz
in the same Listbox_Click sub.

Much appreciated

[Einsener37]

I haven't.
I took out Option Explicit.
If you must define them:
Dim xx,yy,zz
in the same Listbox_Click sub.
I would like to add one listbox with just opportunity to choose rebar
What am I doing wrong in code, that it gives me error


Public Sub UserChoice()
Dim WS As Worksheet
Dim lb2 As MSForms.ListBox
Set WS = ThisWorkbook.Worksheets("Sheet1")
Set lb2 = WS.OLEObjects("ListBox2").Object
lb2.Clear
WS.Range("E20").Resize(, 6).ClearContents
Dim rebars2 As Scripting.Dictionary
Set rebars2 = New Scripting.Dictionary

' 2 rebars
rebars2.Add "2x6", 0.57
rebars2.Add "2x8", 1.01
rebars2.Add "2x10", 1.57
rebars2.Add "2x12", 2.26
rebars2.Add "2x14", 3.08
rebars2.Add "2x16", 4.02
rebars2.Add "2x18", 5.09
rebars2.Add "2x20", 6.28
rebars2.Add "2x22", 7.6
rebars2.Add "2x25", 9.82
rebars2.Add "2x28", 12.32
rebars2.Add "2x32", 16.08
rebars2.Add "2x36", 20.36
rebars2.Add "2x40", 25.13



For i = 0 To rebars2.Count - 1
lb2.AddItem rebars2.Items(i) & " - " & rebars2.Keys(i)

Next i






End Sub

30674

[p45cal]

Make it easy for us to help you, supply a workbook with where you've got to so far.

[Einsener37]

Make it easy for us to help you, supply a workbook with where you've got to so far.

Over here you have to change it to "Sheet1"
30676

[p45cal]

Either:
In the VBE, go to Tools|References… and tick Microsoft Scripting Runtime

30677

or:
change the lines:

Dim rebars2 As Scripting.Dictionary
Set rebars2 = New Scripting.Dictionary
to:

Dim rebars2 As Object
Set rebars2 = CreateObject("Scripting.Dictionary")
and change the line:

lb.AddItem rebars2.Items(i) & " - " & rebars2.Keys(i)
to:

lb.AddItem rebars2.Items()(i) & " - " & rebars2.Keys()(i)

[Einsener37]

Either:
In the VBE, go to Tools|References… and tick Microsoft Scripting Runtime

Yep, i was missing that!:yes
30677

or:
change the lines:

Dim rebars2 As Scripting.Dictionary
Set rebars2 = New Scripting.Dictionary
to:

Dim rebars2 As Object
Set rebars2 = CreateObject("Scripting.Dictionary")
and change the line:

lb.AddItem rebars2.Items(i) & " - " & rebars2.Keys(i)
to:

lb.AddItem rebars2.Items()(i) & " - " & rebars2.Keys()(i)

[Einsener37]

Either:
In the VBE, go to Tools|References… and tick Microsoft Scripting Runtime
Yeah, i was missing that
Could you explain, why do you need extra parentheses to line :


lb.AddItem rebars2.Items()(i) & " - " & rebars2.Keys()(i)

30677

or:
change the lines:

Dim rebars2 As Scripting.Dictionary
Set rebars2 = New Scripting.Dictionary
to:

Dim rebars2 As Object
Set rebars2 = CreateObject("Scripting.Dictionary")
and change the line:

lb.AddItem rebars2.Items(i) & " - " & rebars2.Keys(i)
to:

lb.AddItem rebars2.Items()(i) & " - " & rebars2.Keys()(i)

[p45cal]

Could you explain, why do you need extra parentheses to line :
I don't know, I just did a bit of research and that's what's needed if you use late binding (that is, if you're not using the Microsoft Scripting Runtime reference)

ps, don't quote the whole post, I didn't notice at first that you'd added a question in among the quote.