Reading XML and repeating a value across a cell range

Question

I have the following xml that I would like to import into Excel using VBA

<rootElement xmlns:n0="http://www.w3.org/n0/" xmlns:n1="http://www.w3.org/n1/">
<n0:Partner>
    <n1:Identifier>EMH38</n1:Identifier>
    <n1:A>
        <n1:B>
            <n1:C>WZFR8</n1:C>
            <n1:D>Coll</n1:D>
            <n1:E>1</n1:E>
        </n1:B>
        <n1:B>
            <n1:C>X3HV7</n1:C>
            <n1:D>Coll</n1:D>
            <n1:E>2</n1:E>
        </n1:B>
        <n1:B>
            <n1:C>X5E86</n1:C>
            <n1:D>Coll</n1:D>
            <n1:E>3</n1:E>
        </n1:B>
        <n1:B>
            <n1:C>X5FC6</n1:C>
            <n1:D>Coll</n1:D>
        </n1:B>
        <n1:B>
            <n1:C>X5FL6</n1:C>
            <n1:D>Coll</n1:D>
            <n1:E>5</n1:E>
        </n1:B>
    </n1:A>
</n0:Partner>

After reading in the file, the output in the Excel worksheet was

 Identifier C       D       E
 EMH38      WZFR8      Coll     1
            X3HV7      Coll     2
            X5E86      Coll     3
            X5FC6      Coll 
            X5FL6      Coll     5

The preferred output after reading in the file would have to be the following. How can I make the Identifier appear on each row?

 Identifier C       D       E
 EMH38      WZFR8      Coll     1
 EMH38      X3HV7      Coll     2
 EMH38      X5E86      Coll     3
 EMH38      X5FC6      Coll 
 EMH38      X5FL6      Coll     5

Answer 1

Here, my approach for your problem.

Public Sub readXML()

    Dim xmlUrl As String
    Dim xmlDoc As New MSXML2.DOMDocument
    Dim partner, elements, bNode, child  As MSXML2.IXMLDOMNode
    Dim row As Integer

    'Get xml file path
    xmlUrl = ThisWorkbook.Path & "\test.xml"

    xmlDoc.async = False

    'If loading xml file has no error
    If xmlDoc.Load(xmlUrl) Then

        'Set start row of sheet
        row = 1

        'Get root element from xml document
        Set elements = xmlDoc.DocumentElement

        'Loop all child tags from "n0:Partner" tags
        For Each partner In elements.ChildNodes

            'Loop all child tags from 'n1:A' tags
            For Each bNode In partner.ChildNodes(1).ChildNodes

                Sheets("sheetname").Range("A" & row) = partner.ChildNodes(0).Text

                'Loop all child tags from from 'n1:B' tags
                For Each child In bNode.ChildNodes

                    'Check node name and set value to cell
                    Select Case child.nodeName

                        Case "n1:C"
                            Sheets("sheetname").Range("C" & row) = child.Text

                        Case "n1:D"
                            Sheets("sheetname").Range("D" & row) = child.Text

                        Case "n1:E"
                            Sheets("sheetname").Range("E" & row) = child.Text

                    End Select

                Next child

                'Increase row
                row = row + 1

           Next bNode

        Next partner

    End If

End Sub