How to add custom properties to a cell in Excel

Question

I have a need to store extra information about each cell in an Excel workbook. My plan would be to present this information and allow it to be editable via a custom RibbonBar tab.

I would want to allow a user within Excel to add this extra information to cells and then have this information be persisted when the workbook is saved normally. I'd want this information stored within the workbook, such that emailing the workbook to someone else and them opening the workbook would allow them to see the extra data set on cells.

I cannot find an elegant solution to this. An easy cop-out would be having a 'Tag' like property available on the range objects, but this does not exist.

I could abuse the comment tag on individual cells and store the data as serialised XML , but this just seems wrong.

Is there a better way of achieving this goal?

Thanks

Neil

---

Neil Kimber - Director of Technology, CPR

Answer 1

We have wanted a tag property for cells for a while, but its not in this version of Excel. One way to almost get the same result is to store additional information in the same cell in a different (hidden) worksheet.

Say the hidden sheet is named Sheet2, then add a tag with this method

Sub AddTag(rng As Range, strTag As String)
  Worksheets("Sheet2").Range(rng.Address).Value = strTag
End Sub

Read the tag with a function

Function TagInfo(rng As Range) As String
  TagInfo = Worksheets("Sheet2").Range(rng.Address).Value
End Function

I will let you add code to test for a range with more than one cell...

---

Ed Ferrero
www.edferrero.com

Answer 2

Thanks for the suggestion of using a hidden worksheet. I had also considered this and, in lieu of a better solution, I think I'll try this out.

The other alternative I had was to store the information in a separate file, unfortunately this would require the separate file to be distributed with the workbook. Unless I could do something clever and store the Excel workbook as XML and embed my information into the XML.

The other alternative approach I've considered is using document custom properties.

All of these approaches have different challenges, a Tag on individual cells would be a far preferable solution.

Neil

---

Neil Kimber - Director of Technology, CPR

Answer 3

Re-consider using cell Comments.  Comments were specifically designed to handle this type of functionality.

---

gsnu201202

Answer 4

One way to do this is using CustomXMLParts (which I have only just discovered). You can create and access these whilst the workbook is open and they persist in the workbook (assuming its one of the 2007 or later file formats). You can even read/write them from within a UDF. And they are fairly easy to debug because you can see the end result by unzipping the Excel XLSX file.

You would need a 2-part XML structure where one part is the cell address and the second part is the data you want to store.

here is some test code

Option Explicit
Public gPart As CustomXMLPart
Sub create()
    Dim xPart As CustomXMLPart
    For Each xPart In ActiveWorkbook.CustomXMLParts
        If Not xPart.BuiltIn Then xPart.Delete
    Next xPart
    Set gPart = ActiveWorkbook.CustomXMLParts.Add("<fxlUDF> </fxlUDF>")
End Sub
Sub testxml()
    Dim xPart As CustomXMLPart
    Dim xNode As CustomXMLNode
    Dim xNodes As CustomXMLNodes
    Dim strxml As String
    Dim s1 As String
    Dim j As Long
    For Each xPart In ActiveWorkbook.CustomXMLParts
        If Not xPart.BuiltIn Then xPart.Delete
    Next xPart
    strxml = "<FxlRowMap>" & _
             "<Pair> <k>123</k> <i>456</i> </Pair>" & _
             "<Pair> <k>124</k> <i>999</i> </Pair>" & _
             "</FxlRowMap>"
    Set xPart = ActiveWorkbook.CustomXMLParts.Add(strxml)
    Set xNode = xPart.SelectSingleNode("/FxlRowMap")
    xNode.AppendChildSubtree ("<Pair> <k>125</k> <i>1010</i> </Pair>")
    Set xNodes = xPart.SelectNodes("/FxlRowMap/Pair")
    For Each xNode In xNodes
        s1 = xNode.SelectSingleNode("k").Text
        Debug.Print s1
        Debug.Print xNode.SelectSingleNode("i").Text
    Next xNode
End Sub
Function Funcxml(theRange As Range)
    Dim xNode As CustomXMLNode
    Set xNode = gPart.SelectSingleNode("/fxlUDF")
    xNode.AppendChildSubtree ("<Cell> <RC>" & Application.Caller.Address & "</RC> <V>" & theRange.Value & "</V> </Cell>")
    Funcxml = theRange
End Function

---

Charles Excel MVP The Excel Calculation Site http://www.decisionmodels.com/

Answer 5

when I use the CustomXMLParts solution - what happens if the user inserts/deletes rows/columns?
I must keep track of those changes and adapt all my stored references, right?

from that point of view, the comments solution seems easier (although this is of course also not ideal, because the user can see/change it)

Answer 6

Instead of saving adrresses you could use Names. In a light test this seemed to work for me: First run testAdd and then testGetData

Option Explicit
Function GetXMLPart(sPart As String) As CustomXMLPart
Dim xNode As CustomXMLNode
Dim xPart As CustomXMLPart
    For Each xPart In ActiveWorkbook.CustomXMLParts
        If Not xPart.BuiltIn Then
            Set xNode = xPart.SelectSingleNode("/" & sPart)
            If Not xNode Is Nothing Then
                Set GetXMLPart = xPart
                Exit Function
            End If
        End If
    Next
    Set GetXMLPart = ActiveWorkbook.CustomXMLParts _
                        .Add(Replace("<#> </#>", "#", sPart))
End Function
Sub testAdd()
' add values to B2:B6, name the cells, save names & values in the xml
' move the cells and clear their values
Dim s As String
Dim i As Long
Dim cel As Range, rng As Range
Dim nm As Name
Dim xPart As CustomXMLPart
Dim xNode As CustomXMLNode
    ' delete all previous test stuff
    GetXMLPart(s).Delete
    For Each nm In ActiveWorkbook.Names
        nm.Delete
    Next
    Cells.Clear
    
    s = "myData"
    Set xNode = GetXMLPart(s).SelectSingleNode(s)
    Set rng = Range("B2:B6")
    For Each cel In rng
        i = i + 100
        Set nm = ActiveWorkbook.Names.Add("myData" & cel.Address(0, 0), cel)
        ' nm.Visible = False ' maybe hide from user
        cel.Value = i & " was in " & cel.Address(0, 0)
        xNode.AppendChildSubtree _
                    ("<Cell> <Name>" & cel.Name.Name & "</Name>" & _
                     "<V>" & cel.Value & "</V> </Cell>")
    Next
    ' delete the values and move the range
   ' Stop ' look at the sheet
    rng.Cut Range("B10")
    rng.Clear
    rng.Interior.Color = 1234567
End Sub
Sub testGetData()
' put the original data back where it belongs
Dim s$
Dim cel As Range
Dim nm As Name
    s = "myData"
    Dim xNode As CustomXMLNode
    Dim xNodes As CustomXMLNodes
    Set xNodes = GetXMLPart(s).SelectNodes("/" & s & "/Cell")
    For Each xNode In xNodes
        Set cel = ActiveWorkbook.Names(xNode.SelectSingleNode("Name").Text).RefersToRange
        cel.Value = xNode.SelectSingleNode("V").Text
    Next
    
End Sub

In the GetXMLPart function I'm sure there must be a more direct way to return the CustomXMLPart (if it exists) than testing if the given CustomXMLNode exists, if anyone has a better way?

Peter Thornton