Excelnoob223
New Member
- Joined
- Jan 18, 2025
- Messages
- 1
- Office Version
- 365
- Platform
- Windows
Hello everyone,
I am trying to add a new measures using VBA to my power pivot data model. Unfortunately I keep getting this run time error 438. I am using windows microsoft 365. Below you can find the whole code. I have colored red the part of the code that is giving me the previously mentioned error. I would appreciate any kind of advice.
Sub FindUniqueElementsAndCompare3()
Dim ws As Worksheet
Dim tbl As ListObject
Dim col As ListColumn
Dim dict1 As Object
Dim dict2 As Object
Dim uniqueDict As Object
Dim cell As Range
Dim MyMeasureName As String
Dim formula As String
Dim myModel As Model
Dim myModelTable As ModelTable
Dim measure As ModelMeasure
Dim key As Variant
' Set the worksheet and table
Set ws = ThisWorkbook.Sheets("LO") ' Change to your sheet name
Set tbl = ws.ListObjects("tbl_outloook") ' Change to your table name
Set col = tbl.ListColumns("LO version") ' Change to your column name
' Create dictionaries to store unique values
Set dict1 = CreateObject("Scripting.Dictionary")
Set dict2 = CreateObject("Scripting.Dictionary")
Set uniqueDict = CreateObject("Scripting.Dictionary")
' Get the data model
Set myModel = ThisWorkbook.Model
Set myModelTable = myModel.ModelTables("tbl_outloook") ' Change to your table name
' Populate the first dictionary with unique elements from the column
For Each cell In col.DataBodyRange
If Not dict1.Exists(cell.Value) Then
dict1.Add cell.Value, Nothing
End If
Next cell
' Loop through each measure in the model
For Each measure In myModel.ModelMeasures
If Not dict2.Exists(measure.Name) Then
dict2.Add measure.Name, Nothing
End If
Next measure
' Find elements that are in the first dictionary but not in the second
For Each key In dict1.Keys
If Not dict2.Exists(key) Then
uniqueDict.Add key, dict1(key)
End If
Next key
' Loop through each unique element and create a measure
For Each key In uniqueDict.Keys
MyMeasureName = key
formula = "SUM(tbl_outloook[Value])" ' Adjust the formula as needed
myModel.ModelMeasures.Add MeasureName:=MyMeasureName, _
associatedTable:=myModelTable, _
formula:=formula, _
FormatInformation:=myModel.ModelFormatNumber
Next key
End Sub
Best Regards,
I am trying to add a new measures using VBA to my power pivot data model. Unfortunately I keep getting this run time error 438. I am using windows microsoft 365. Below you can find the whole code. I have colored red the part of the code that is giving me the previously mentioned error. I would appreciate any kind of advice.
Sub FindUniqueElementsAndCompare3()
Dim ws As Worksheet
Dim tbl As ListObject
Dim col As ListColumn
Dim dict1 As Object
Dim dict2 As Object
Dim uniqueDict As Object
Dim cell As Range
Dim MyMeasureName As String
Dim formula As String
Dim myModel As Model
Dim myModelTable As ModelTable
Dim measure As ModelMeasure
Dim key As Variant
' Set the worksheet and table
Set ws = ThisWorkbook.Sheets("LO") ' Change to your sheet name
Set tbl = ws.ListObjects("tbl_outloook") ' Change to your table name
Set col = tbl.ListColumns("LO version") ' Change to your column name
' Create dictionaries to store unique values
Set dict1 = CreateObject("Scripting.Dictionary")
Set dict2 = CreateObject("Scripting.Dictionary")
Set uniqueDict = CreateObject("Scripting.Dictionary")
' Get the data model
Set myModel = ThisWorkbook.Model
Set myModelTable = myModel.ModelTables("tbl_outloook") ' Change to your table name
' Populate the first dictionary with unique elements from the column
For Each cell In col.DataBodyRange
If Not dict1.Exists(cell.Value) Then
dict1.Add cell.Value, Nothing
End If
Next cell
' Loop through each measure in the model
For Each measure In myModel.ModelMeasures
If Not dict2.Exists(measure.Name) Then
dict2.Add measure.Name, Nothing
End If
Next measure
' Find elements that are in the first dictionary but not in the second
For Each key In dict1.Keys
If Not dict2.Exists(key) Then
uniqueDict.Add key, dict1(key)
End If
Next key
' Loop through each unique element and create a measure
For Each key In uniqueDict.Keys
MyMeasureName = key
formula = "SUM(tbl_outloook[Value])" ' Adjust the formula as needed
myModel.ModelMeasures.Add MeasureName:=MyMeasureName, _
associatedTable:=myModelTable, _
formula:=formula, _
FormatInformation:=myModel.ModelFormatNumber
Next key
End Sub
Best Regards,