My Code is as follows:

Sub UniquePartsMod()

Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swComp  As SldWorks.Component2

Dim swCompModel As ModelDoc2

Dim swMass As SldWorks.MassProperty

Set swApp = GetObject(, "SldWorks.Application")

Set swModel = swApp.ActiveDoc

Dim vDepend As Variant

Dim boolOK As Boolean

Dim Density As Double

vDepend = swApp.GetDocumentDependencies2(swModel.GetPathName, True, True, False)

For i = 0 To (UBound(vDepend) - 1) / 2

        If Not swApp.IGetOpenDocumentByName2(vDepend(2 * i + 1)) Is Nothing Then

            Set swCompModel = swApp.IGetOpenDocumentByName2(vDepend(2 * i + 1))

        Else

            Debug.Print "EXCLUDED:   " & vDepend(2 * i)

            GoTo skip

        End If

        Set swMass = swCompModel.Extension.CreateMassProperty

        If Not swMass.UserAssigned = False Then

            Debug.Print swCompModel.GetPathName

            Mass = swMass.Mass

            Volume = swMass.Volume

            Density = Mass / Volume

            Debug.Print "Mass: " & Mass

            Debug.Print "Volume: " & Volume

            Debug.Print "Calc Density: " & Density

            swMass.UserAssigned = False

            oldDensity = swCompModel.GetUserPreferenceDoubleValue(swMaterialPropertyDensity)

            boolOK = swCompModel.SetUserPreferenceDoubleValue(swMaterialPropertyDensity, Density)

            Debug.Print boolOK

        End If

skip:

Next i

End Sub

The new density is not setting even though Debug.Print boolOK returns true