How to Construct a Key in VBA code Resulting in Run Time Error "Type Mis match"

Question

basically the idea is I need to group the sum of figures based on the specific column in Sheet1 and update in Sheet 2... Right now the below code is throwing error on type mismatch on Key one. Columns ( 9, 10, 11, 18, 19, 20, 21) are the key columns from sheet 1 and I need group the sum in sheet1 based on the unique columns and update in sheet 2

Sub UpdatePremiumValues()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim dataRange1 As Range
    Dim dataRange2 As Range
    Dim cell As Range
    Dim dict As Object
    
    ' Set references to the worksheets
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    
    ' Find the last row with data in Sheet1 and Sheet2
    lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
    
    ' Set the data ranges in Sheet1 and Sheet2
    Set dataRange1 = ws1.Range("A2:AI" & lastRow1) ' Adjust columns as needed
    Set dataRange2 = ws2.Range("A2:AI" & lastRow2) ' Adjust columns as needed
    
    ' Create a dictionary to store grouping and sum data
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' Loop through data in Sheet1 and update dictionary
    For Each cell In dataRange1.Rows
        Dim key As String
        Dim values(1 To 6) As Double
           
    ' Construct the key string
        key = Join(Application.Index(cell.Resize(1, 7).Value, 1, Array(9, 10, 11, 18, 19, 20, 21)), "|")
        ' Check if the value in each column is numeric
        For i = 1 To 7
            If Not IsNumeric(cell.Cells(1, i).Value) Then
                Exit For
            End If
        Next i
        
        ' Add the key to the dictionary
        dict(key) = values
     
        
        Debug.Print "Key: " & key
        If dict.Exists(key) Then
            ' Update values based on grouping
            dict(key)(1) = dict(key)(1) + cell.Cells(1, 28).Value ' Net Premium (SGD)
            dict(key)(2) = dict(key)(2) + cell.Cells(1, 29).Value ' 1st Premium (SGD)
            dict(key)(3) = dict(key)(3) + cell.Cells(1, 30).Value ' 2nd Premium (SGD)
            dict(key)(4) = dict(key)(4) + cell.Cells(1, 34).Value ' FO Premium (SGD)
            dict(key)(5) = dict(key)(5) + cell.Cells(1, 35).Value ' Fac HO Premium (SGD)
            dict(key)(6) = dict(key)(6) + cell.Cells(1, 36).Value ' Fac Others Premium (SGD)
        Else
            'Dim values(1 To 6) As Double
            values(1) = cell.Cells(1, 28).Value ' Net Premium (SGD)
            values(2) = cell.Cells(1, 29).Value ' 1st Premium (SGD)
            values(3) = cell.Cells(1, 30).Value ' 2nd Premium (SGD)
            values(4) = cell.Cells(1, 34).Value ' FO Premium (SGD)
            values(5) = cell.Cells(1, 35).Value ' Fac HO Premium (SGD)
            values(6) = cell.Cells(1, 36).Value ' Fac Others Premium (SGD)
            dict(key) = values
        End If
    Next cell
    
    ' Update values in Sheet2 based on dictionary
    For Each cell In dataRange2.Rows
          If dict.Exists(key) Then
            ' Update values in Sheet2 based on grouping
            cell.Cells(1, 21).Value = dict(key)(1) ' Net Premium (SGD)
            cell.Cells(1, 22).Value = dict(key)(2) ' 1st Premium (SGD)
            cell.Cells(1, 23).Value = dict(key)(3) ' 2nd Premium (SGD)
            cell.Cells(1, 27).Value = dict(key)(4) ' FO Premium (SGD)
            cell.Cells(1, 28).Value = dict(key)(5) ' Fac HO Premium (SGD)
            cell.Cells(1, 29).Value = dict(key)(6) ' Fac Others Premium (SGD)
        End If
    Next cell
    
    ' Clean up
    Set dict = Nothing
    MsgBox "Values updated based on grouping!"
End Sub

You can't update an array stored in a dictionary - you need to first pull it out into a variable, then work with the array before placing it back into the dictionary. Eg see https://stackoverflow.com/questions/21940111/updating-an-array-stored-in-a-vba-dictionary — Tim Williams, Aug 03 '23 at 05:36
How does the key relate to the rows in sheet2? You're only testing if `dict.Exists(key)`, which will always be true... — Tim Williams, Aug 03 '23 at 06:38

score 1 · Answer 1 · answered Aug 03 '23 at 06:03

1

In this line

key = Join(Application.Index(cell.Resize(1, 7).Value, 1, Array(9, 10, 11, 18, 19, 20, 21)), "|")

you get a seven cells range. The Index function will accept columns till 7.

Cannot collect the values from columns bigger then 7.

Try this

key = Join(Application.Index(cell.Resize(1, 21).Value, 1, Array(9, 10, 11, 18, 19, 20, 21)), "|")

answered Aug 03 '23 at 06:03

Black cat

1,056
1
2
11

1

Safer to maybe just drop the `Resize()` since `cell` is already a row covering columns A to AI – Tim Williams Aug 03 '23 at 06:28

score 0 · Answer 2 · answered Aug 03 '23 at 06:45

You can't update an array stored in a dictionary - you need to first pull it out into a variable, then work with the array before placing it back into the dictionary.

For example:

Sub UpdatePremiumValues()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim dataRange1 As Range
    Dim dataRange2 As Range
    Dim rw As Range
    Dim dict As Object, arrSum, arrSumCols, i As Long, el, key As String
    
    ' Set references to the worksheets
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    
    ' Find the last row with data in Sheet1 and Sheet2
    lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).row
    lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).row
    
    ' Set the data ranges in Sheet1 and Sheet2
    Set dataRange1 = ws1.Range("A2:AI" & lastRow1) ' Adjust columns as needed
    Set dataRange2 = ws2.Range("A2:AI" & lastRow2) ' Adjust columns as needed
    
    ' Create a dictionary to store grouping and sum data
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' Loop through data in Sheet1 and update dictionary
    For Each rw In dataRange1.Rows
        
        ' Construct the key string
        key = Join(Application.Index(rw, 1, Array(9, 10, 11, 18, 19, 20, 21)), "|")
        
        For i = 1 To 7 ' Check if the value in each column is numeric
            If Not IsNumeric(rw.Cells(1, i).Value) Then Exit For
        Next i
        
        Debug.Print "Key: " & key
        If Not dict.Exists(key) Then 'add key and array if not already there
            Dim values(1 To 6) As Double
            dict(key) = values 'all elements default to zero
        End If
        
        i = 1
        arrSum = dict(key) 'pull out the array
        For Each el In Array(28, 29, 30, 34, 25, 36)
            arrSum(i) = arrSum(i) + rw.Cells(el).Value
            i = i + 1
        Next el
        dict(key) = arrSum 'replace the array
    Next rw
    
    ' Update values in Sheet2 based on dictionary
    For Each rw In dataRange2.Rows
          'don't you need to calculate a key here???
          If dict.Exists(key) Then
            i = 1
            arrSum = dict(key) 'pull out the array
            For Each el In Array(21, 22, 23, 27, 28, 29)
                rw.Cells(el).Value = arrSum(i)
                i = i + 1
            Next el
        End If
    Next rw
    
    MsgBox "Values updated based on grouping!"
End Sub

How to Construct a Key in VBA code Resulting in Run Time Error "Type Mis match"

2 Answers2