Counting and correlating XML data in a VBA macro

Question

I'm trying to write an Excel macro that reads an XML file. This XML file consists of a series of lists of fields, each enclosed in <master> </master>. There are a random number of these <master>tags. Each set of master tags contains two other fields: <proto></proto> and <status></status>, plus a number of other fields that I'm not concerned with for this macro.

both the <proto> and <status> fields can each have one of three different entries. say I, II, and III in <proto> and red, yellow, and green in <status>. So a file might be formatted as follows:

<master>
 <proto>
    III
  </proto>
  <status>
    red
  </status>
</master>

with dozens or hundreds of these, just with different values.

What I'm trying to do is count the number of each combination of possibilities here, and assign each to a variable.

So, for example, variable proto1red will have the total number of times a <master> field contains both <proto>I</proto> and <status>red</status> and variable proto2red will have the total number of times a <master> field contains <proto>II</proto> and <status>red</status>.

This is where I'm starting, basically just trying to adapt a different script I wrote that counts various items in a csv file.

Dim intChoice As Integer
Dim strPath As String
'Remove all other filters
Call Application.FileDialog(msoFileDialogOpen).Filters.Clear
'only allow the user to select one file
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
'Add a custom filter
Call Application.FileDialog(msoFileDialogOpen).Filters.Add( _
    "CR Files Only", "*.cr")
'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogOpen).Show
'determine what choice the user made
If intChoice <> 0 Then
    'get the file path selected by the user
    crfile = Application.FileDialog( _
        msoFileDialogOpen).SelectedItems(1)

(.cr is just an extension used for an xml file for use in a custom application we use). After this portion are just the variables being dimmed and relevant lines being counted for the other filetype. I'm not sure how to use VBA to count the fields as I described previously, and assign that number to a variable.

Answer 1

Something like this? You don't actually need the delimiter ",". This was just for ease of reading. I am assuming Status/Proto don't repeat within a single Master? If they do then the getElementsByTagName part needs to loop an entire collection rather than just using the index 0.

Using your variable names:

Option Explicit

Public Sub testing()
    Dim xmlDoc As New MSXML2.DOMDocument60
    Set xmlDoc = New MSXML2.DOMDocument60
    xmlDoc.Load "C:\Users\User\Desktop\Test2.xml"
    Dim dict As Object, key As Variant
    Set dict = CreateObject("Scripting.Dictionary")
    Dim Node As IXMLDOMElement
    For Each Node In xmlDoc.SelectNodes("//MASTER")
        On Error Resume Next
        Dim jkey As String
        jkey = Node.getElementsByTagName("PROTO")(0).Text & "," & Node.getElementsByTagName("STATUS")(0).Text
        If Not dict.exists(jkey) Then
            dict.Add jkey, 1
        Else
            dict(jkey) = dict(jkey) + 1
        End If
        On Error GoTo 0
    Next Node

    Dim Proto1Red As Long, Proto2Red As Long, Proto3Red As Long
    Dim Proto1Green As Long, Proto2Green As Long, Proto3Green As Long
    Dim Proto1Yellow As Long, Proto2Yellow As Long, Proto3Yellow As Long
    Dim ikey As Variant
    For Each ikey In dict.keys
       ' Debug.Print iKey, dict(key)
        Select Case ikey
        Case "I,Red"
            Proto1Red = dict(ikey)
        Case "II,Red"
            Proto2Red = dict(ikey)
        Case "III,Red"
            Proto3Red = dict(ikey)
        Case "I,Green"
            Proto1Green = dict(ikey)
        Case "II,Green"
            Proto2Green = dict(ikey)
        Case "III,Green"
            Proto3Green = dict(ikey)
        Case "I,Yellow"
            Proto1Yellow = dict(ikey)
        Case "II,Yellow"
            Proto2Yellow = dict(ikey)
        Case "III,Yellow"
            Proto3Yellow = dict(ikey)
        End Select
    Next

    Dim arr(), i As Long
    arr = Array(Proto1Red, Proto2Red, Proto3Red, Proto1Green, Proto2Green, Proto3Green, Proto1Yellow, Proto2Yellow, Proto3Yellow)

    For i = LBound(arr) To UBound(arr)
        Debug.Print arr(i)
    Next i
End Sub

---

Concatenating with Proto:

Option Explicit
Public Sub testing()
    Dim xmlDoc As New MSXML2.DOMDocument60
    Set xmlDoc = New MSXML2.DOMDocument60
    xmlDoc.Load "C:\Users\User\Desktop\Test2.xml"
    Dim dict As Object, key As Variant
    Set dict = CreateObject("Scripting.Dictionary")
    Dim Node As IXMLDOMElement
    For Each Node In xmlDoc.SelectNodes("//MASTER")
        On Error Resume Next
        Dim jkey As String
        jkey = "Proto" & Node.getElementsByTagName("PROTO")(0).Text & Node.getElementsByTagName("STATUS")(0).Text
        If Not dict.Exists(jkey) Then
            dict.Add jkey, 1
        Else
            dict(jkey) = dict(jkey) + 1
        End If
        On Error GoTo 0
    Next Node

    Dim Proto1Red As Long, Proto2Red As Long, Proto3Red As Long
    Dim Proto1Green As Long, Proto2Green As Long, Proto3Green As Long
    Dim Proto1Yellow As Long, Proto2Yellow As Long, Proto3Yellow As Long
    Dim ikey As Variant
    For Each ikey In dict.keys
       ' Debug.Print iKey, dict(key)
        Select Case ikey
        Case "I,Red"
            Proto1Red = dict(ikey)
        Case "II,Red"
            Proto2Red = dict(ikey)
        Case "III,Red"
            Proto3Red = dict(ikey)
        Case "I,Green"
            Proto1Green = dict(ikey)
        Case "II,Green"
            Proto2Green = dict(ikey)
        Case "III,Green"
            Proto3Green = dict(ikey)
        Case "I,Yellow"
            Proto1Yellow = dict(ikey)
        Case "II,Yellow"
            Proto2Yellow = dict(ikey)
        Case "III,Yellow"
            Proto3Yellow = dict(ikey)
        End Select
    Next

    Dim arr(), i As Long
    arr = Array(Proto1Red, Proto2Red, Proto3Red, Proto1Green, Proto2Green, Proto3Green, Proto1Yellow, Proto2Yellow, Proto3Yellow)

    For Each key In dict.keys
        Debug.Print key, dict(key)
    Next key
End Sub

---

Output:

Answer 2

I had similar task, I used app from windows store to convert xml into excel and then added pivoting and chart to excel file.

Answer 3

Consider XSLT, the special purpose langauge designed to transform XML files. Specifically, use the Muenchian Method which indexes the document with a key according to specific values like PROTO and STATUS and can be used to count distinct groupings (i.e., all combinations). VBA can use XSLT using the MSXML library and even import flattned output into a workbook as a tabular structure:

XSLT (save as .xsl file to be sourced in VBA)

<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
    <xsl:output indent="yes"/>
    <xsl:strip-space elements="*"/>

    <xsl:key name="combn_key" match="MASTER" use="concat(descendant::PROTO, descendant::STATUS)" />

    <xsl:template match="/SILVERS">
        <root>
          <xsl:apply-templates select="ISILVER/MASTER[generate-id() = 
                                       generate-id(key('combn_key', concat(descendant::PROTO, descendant::STATUS))[1])]"/>
        </root>
    </xsl:template>

    <xsl:template match="MASTER">
        <data>
            <xsl:variable name="pair" select="concat('proto', descendant::PROTO, descendant::STATUS)"/>
            <pair><xsl:value-of select="$pair"/></pair>
            <count><xsl:value-of select="count(. | key('combn_key', concat(descendant::PROTO, descendant::STATUS)))"/></count>
        </data>
    </xsl:template>

</xsl:stylesheet>

VBA

' SET REFERENCE TO Micrsoft XML, v#.#
Dim xmldoc As New MSXML2.DOMDocument, xslDoc As New MSXML2.DOMDocument, newDoc As New MSXML2.DOMDocument

' LOAD XML AND XSL FILES
xmldoc.async = False
xmldoc.Load "C:\Path\To\Input.xml"

xslDoc.async = False
xslDoc.Load "C:\Path\To\XSL\Script.xsl"

' TRANSFORM XML
xmldoc.transformNodeToObject xslDoc, newDoc
newDoc.Save "C:\Path\To\Output.xml"

' IMPORT RESULT XML
Application.Workbooks.OpenXML "C:\Path\To\Output.xml", , xlXmlLoadImportToList

XML Output

<?xml version="1.0" encoding="utf-8"?>
<root>
  <data>
    <pair>protoIIIRed</pair>
    <count>1</count>
  </data>
  <data>
    <pair>protoIRed</pair>
    <count>1</count>
  </data>
</root>

Excel Import (same pairings will increase counts more than 1)