VBA Code to Store Columns into Respective Scripting Dictionaries and Multiply Them and then Output Them

OilEconomist

Active Member
Joined
Dec 26, 2016
Messages
421
Office Version
  1. 2019
Platform
  1. Windows
Thanks in advance for your assistance. Actually, it doesn't have to be the method I have proposed with sample code as I am just looking for the most efficient and fastest method.

What is the VBA Code to read in two columns into two respective Scripting Dictionaries and then perform an operation such as multiplication. The following is code I have written thus far, but it gives me nothing for the output and I have also done a test where I read in the values from columns 5 and 6 and put them into columns 7 and 8 respectively, but the cells are in columns 7 and 8 show up blank which leads me to believe they are not being read into their respective dictionaries.

Sample data set. Column G has the final values I am trying to calc.
Tickers, Missing - (2022-04-01, V01) - 1 of .csv
EFG
8PriceQuantityTotal
9$3.002$6.00
10$4.0010$40.00
11$4.5011$49.50
Sheet2
Cell Formulas
RangeFormula
G9:G11G9=E9*F9


Code:
VBA Code:
Sub TestDictOperation()
       'Dimensioning
     Dim i As Long, LastRow As Long
     Dim ShtNm As String
     Dim Dict1 As Object, Dict2 As Object, Dict3 As Object
     
     
    'Set sheet
     ShtNm = ActiveSheet.name
    
    
    'Code - find last row
     With Sheets(ShtNm)
        LastRow = .Cells.Find(What:="*", AFTER:=.Cells(1), _
                    SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
     End With
        
        
    'Set dictionaries
     Set Dict1 = CreateObject("Scripting.Dictionary")
     Set Dict2 = CreateObject("Scripting.Dictionary")
     Set Dict3 = CreateObject("Scripting.Dictionary")
    
    
    'Read in values and if both of the cells were not blank, then multiply and output
     With Sheets(ShtNm)
        For i = 9 To LastRow
            Dict1(.Cells(i, 5).Value) = Empty
            Dict2(.Cells(i, 6).Value) = Empty
            
            If Dict1(.Cells(i, 5).Value) <> "" And Dict2(.Cells(i, 6).Value) <> "" Then
                .Cells(i, 7) = Dict1(.Cells(i, 5).Value) * Dict2(.Cells(i, 6).Value)
            End If
        Next i
     End With

End Sub
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
With your first iteration of your loop, Dict1(.Cells(i, 5).Value) = Empty means that the key is $3.00, and the item is empty. And the same thing applies to the other one. Hence, your If statement will always evaluate to False.

It seems to me, though, there's no real need to use dictionaries in this scenario. Maybe something like this would suffice...

VBA Code:
Sub test()

    Dim data As Variant
    data = Range("E9:G" & Cells(Rows.Count, "E").End(xlUp).Row).Value
    
    Dim i As Long
    With data
        For i = LBound(data, 1) To UBound(data, 1)
            data(i, 3) = data(i, 1) * data(i, 2)
        Next i
    End With
    
    Range("G9").Resize(UBound(data, 1)).Value = Application.Index(data, 0, 3)
    
End Sub

Hope this helps!
 
Upvote 0
With your first iteration of your loop, Dict1(.Cells(i, 5).Value) = Empty means that the key is $3.00, and the item is empty. And the same thing applies to the other one. Hence, your If statement will always evaluate to False.

It seems to me, though, there's no real need to use dictionaries in this scenario. Maybe something like this would suffice...

VBA Code:
Sub test()

    Dim data As Variant
    data = Range("E9:G" & Cells(Rows.Count, "E").End(xlUp).Row).Value
   
    Dim i As Long
    With data
        For i = LBound(data, 1) To UBound(data, 1)
            data(i, 3) = data(i, 1) * data(i, 2)
        Next i
    End With
   
    Range("G9").Resize(UBound(data, 1)).Value = Application.Index(data, 0, 3)
   
End Sub

Hope this helps!
@Domenic Thanks so much for your quick response and solution. That worked. I wanted to use Scripting Dictionaries as I was told that they were the fasted method and I have a large data set. I guess I will have to try it on my large data set. Do you know if this method is just as fast?
 
Upvote 0
VBA Code:
Sub TestDictOperation()
       'Dimensioning
     Dim i As Long, LastRow As Long
     Dim ShtNm As String
     Dim Dict1 As Object, Dict2 As Object, Dict3 As Object
     
     
    'Set sheet
     ShtNm = ActiveSheet.Name
    
    
    'Code - find last row
     With Sheets(ShtNm)
        LastRow = .Cells.Find(What:="*", AFTER:=.Cells(1), _
                    SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                    
     End With
    'Set dictionaries
     Set Dict1 = CreateObject("Scripting.Dictionary")
         Dict1.CompareMode = 1
     Set Dict2 = CreateObject("Scripting.Dictionary")
     Set Dict3 = CreateObject("Scripting.Dictionary")
    'Read in values and if both of the cells were not blank, then multiply and output
     With Sheets(ShtNm)
        For i = 9 To LastRow
            Dict1(.Cells(i, 5).Value) = .Cells(i, 5).Value
            Dict2(.Cells(i, 6).Value) = .Cells(i, 6).Value
            If Dict1(.Cells(i, 5).Value) <> "0" And Dict2(.Cells(i, 6).Value) <> "0" Then
                .Cells(i, 7) = Dict1(.Cells(i, 5).Value) * Dict2(.Cells(i, 6).Value)
            End If
        Next i
     End With

End Sub
 
Upvote 0
Since you declared Dict3
VBA Code:
Sub TestDictOperation()
'Dimensioning
    Dim a
    Dim i As Long, LastRow As Long
    Dim ShtNm As String
    Dim Dict1 As Object, Dict2 As Object, Dict3 As Object


    'Set sheet
    ShtNm = ActiveSheet.Name


    'Code - find last row
    With Sheets(ShtNm)
        LastRow = .Cells.Find(What:="*", AFTER:=.Cells(1), _
                              SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        a = Cells(9, 5).Resize(LastRow, 2)
    End With
    'Set dictionaries
    Set Dict1 = CreateObject("Scripting.Dictionary")
    Dict1.CompareMode = 1
    Set Dict2 = CreateObject("Scripting.Dictionary")
    Dict2.CompareMode = 1
    Set Dict3 = CreateObject("Scripting.Dictionary")
    Dict3.CompareMode = 1
    'Read in values and if both of the cells were not blank, then multiply and output
    With Sheets(ShtNm)
        For i = 1 To UBound(a)
            Dict1(a(i, 1)) = a(i, 1)
            Dict2(a(i, 2)) = a(i, 2)
            If Dict1(a(i, 1)) <> "0" And Dict2(a(i, 2)) <> "0" Then
                Dict3(Dict1(a(i, 1)) * Dict2(a(i, 2))) = Dict1(a(i, 1)) * Dict2(a(i, 2))
            End If
        Next i
        .Cells(9, 7).Resize(Dict3.Count) = Application.Transpose(Dict3.items)
    End With

End Sub
 
Upvote 0
Another option is
VBA Code:
Sub OilEconomist()
   With Range("G2:G" & Range("E" & Rows.Count).End(xlUp).Row)
      .Value = Evaluate("if({1}," & .Offset(, -2).Address & "*" & .Offset(, -1).Address & ")")
   End With
End Sub
 
  • Like
Reactions: jxb
Upvote 0
@Domenic Thanks so much for your quick response and solution. That worked. I wanted to use Scripting Dictionaries as I was told that they were the fasted method and I have a large data set. I guess I will have to try it on my large data set. Do you know if this method is just as fast?
Dictionaries are great to store key/value pairs so that you can easily lookup any value using its key. However, in your example, you need to loop through each item sequentially in order to perform your operations. So I don't think there's any real advantage to using a dictionary in this case. And, it's likely that arrays (or the alternative offered by @Fluff) would be more efficient.
 
Upvote 0
Since you declared Dict3
VBA Code:
Sub TestDictOperation()
'Dimensioning
    Dim a
    Dim i As Long, LastRow As Long
    Dim ShtNm As String
    Dim Dict1 As Object, Dict2 As Object, Dict3 As Object


    'Set sheet
    ShtNm = ActiveSheet.Name


    'Code - find last row
    With Sheets(ShtNm)
        LastRow = .Cells.Find(What:="*", AFTER:=.Cells(1), _
                              SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        a = Cells(9, 5).Resize(LastRow, 2)
    End With
    'Set dictionaries
    Set Dict1 = CreateObject("Scripting.Dictionary")
    Dict1.CompareMode = 1
    Set Dict2 = CreateObject("Scripting.Dictionary")
    Dict2.CompareMode = 1
    Set Dict3 = CreateObject("Scripting.Dictionary")
    Dict3.CompareMode = 1
    'Read in values and if both of the cells were not blank, then multiply and output
    With Sheets(ShtNm)
        For i = 1 To UBound(a)
            Dict1(a(i, 1)) = a(i, 1)
            Dict2(a(i, 2)) = a(i, 2)
            If Dict1(a(i, 1)) <> "0" And Dict2(a(i, 2)) <> "0" Then
                Dict3(Dict1(a(i, 1)) * Dict2(a(i, 2))) = Dict1(a(i, 1)) * Dict2(a(i, 2))
            End If
        Next i
        .Cells(9, 7).Resize(Dict3.Count) = Application.Transpose(Dict3.items)
    End With

End Sub
Thanks @mohadin for your response and apologies that I still have not let you know if this works as I have been working through this as time as allowed. One quick question in regards to this line of code:

Rich (BB code):
a = Cells(9, 5).Resize(LastRow, 2)
I see that 9 is for row 9, 5 is for the 5th column (column E), and LastRow is for the last row of data, but what is the 2 for?
 
Upvote 0
It's resizing the range to 2 columns wide.
 
Upvote 0

Forum statistics

Threads
1,212,927
Messages
6,110,729
Members
448,294
Latest member
jmjmjmjmjmjm

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