Excel XML data feed making row data out of line

Question

I have an XML feed that is drawing a list of email addresses sorted in alphabetical order into Sheet 1

In Sheet 2 I have the list of email addresses in column 1 and then several other columns with user information.

When I refresh the data and a new email is added to the list, the list of email addresses in column 1 is shifted down and therefore the data in the other columns is out of line. Is there anyway I can insert a new row and shift all data down in all the columns if and when a new address is added into column 1. Similarly, remove a line of data if the email is removed from the feed.

I know this is really meant to be in a database but I don't have that option.

Thanks in advance!

Answer 1

First of all, since there is lack of information, I will assume a scenario to work from and try to achieve what you need. You might have to change the code a little to fit your needs, but this gives you a base to work.

Since your XML feed does not contain additional data, the table containing the e-mail addresses will not add rows to the rest of the table as you want. My suggestion is that you use vba code to do the job for you.

Assuming you have the following xml file:

<?xml version="1.0" encoding="UTF-8"?>
<Email>
    <address>[email protected]</address>
    <address>[email protected]</address>
    <address>[email protected]</address>
    <address>[email protected]</address>
    <address>[email protected]</address>
    <address>[email protected]</address>
</Email>

Using the following code will generate a table on the worksheet:

Const xmlFileUrl As String = "c:\filePath\note.xml"
Sub ClearXmlMaps()

    Dim existingXmlMap As XmlMap

    For Each existingXmlMap In ActiveWorkbook.XmlMaps

       existingXmlMap.Delete

    Next existingXmlMap

End Sub

Sub CreateMailList()

    Dim xmlTable As XmlMap

    ClearXmlMaps

    Application.WindowState = xlNormal
    ActiveWorkbook.XmlImport URL:=xmlFileUrl, ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$A$1")

    Set xmlTable = ActiveWorkbook.XmlMaps(1)

    xmlTable.Name = "EmailList"

End Sub

The code generated the red squared part of the table below:

And I have added a new column called "Name". Now suppose I want to refresh my XML feed without clearing all information on the column name. For that, I will use an auxiliary sheet (my main sheet here is the "Data" and the auxiliary is the "Aux" sheet) to copy all data, refresh the feed, and finally, refill my table with the last state by using the VLOOKUP command, such as below:

Sub RefreshEmailList()

    Dim existingXmlMap As XmlMap
    Dim dataSheet As Worksheet
    Dim auxSheet As Worksheet

    Set dataSheet = ThisWorkbook.Worksheets("Data")
    Set auxSheet = ThisWorkbook.Worksheets("Aux")

    dataSheet.Cells.Copy auxSheet.Cells(1, 1)

    auxSheet.Range(auxSheet.Cells(1, 1), auxSheet.Cells(auxSheet.Cells(auxSheet.Rows.Count, 1).End(xlUp).Row, auxSheet.Cells(1, auxSheet.Columns.Count).End(xlToLeft).Column)).Value = auxSheet.Range(auxSheet.Cells(1, 1), auxSheet.Cells(auxSheet.Cells(auxSheet.Rows.Count, 1).End(xlUp).Row, auxSheet.Cells(1, auxSheet.Columns.Count).End(xlToLeft).Column)).Value


    dataSheet.Range(dataSheet.Cells(2, 2), dataSheet.Cells(dataSheet.Cells(dataSheet.Rows.Count, 1).End(xlUp).Row, dataSheet.Cells(1, dataSheet.Columns.Count).End(xlToLeft).Column)).Clear

    For Each existingXmlMap In ThisWorkbook.XmlMaps

        If existingXmlMap.Name = "EmailList" Then

            ActiveWorkbook.XmlMaps("EmailList").DataBinding.Refresh

        End If

    Next existingXmlMap

    dataSheet.Range(dataSheet.Cells(2, 2), dataSheet.Cells(dataSheet.Cells(dataSheet.Rows.Count, 1).End(xlUp).Row, dataSheet.Cells(1, dataSheet.Columns.Count).End(xlToLeft).Column)).FormulaR1C1 = "=IFERROR(IF(VLOOKUP([@address],Aux!C1:C,COLUMN(),FALSE) = 0 , """", VLOOKUP([@address],Aux!C1:C,COLUMN(),FALSE)), """")"
    dataSheet.Range(dataSheet.Cells(2, 2), dataSheet.Cells(dataSheet.Cells(dataSheet.Rows.Count, 1).End(xlUp).Row, dataSheet.Cells(1, dataSheet.Columns.Count).End(xlToLeft).Column)).Value = dataSheet.Range(dataSheet.Cells(2, 2), dataSheet.Cells(dataSheet.Cells(dataSheet.Rows.Count, 1).End(xlUp).Row, dataSheet.Cells(1, dataSheet.Columns.Count).End(xlToLeft).Column)).Value


End Sub

If you change the xml file to the following:

<?xml version="1.0" encoding="UTF-8"?>
<Email>
    <address>[email protected]</address>
    <address>[email protected]</address>
    <address>[email protected]</address>
    <address>[email protected]</address>
    <address>[email protected]</address>
    <address>[email protected]</address>
    <address>[email protected]</address>
</Email>

And then run the RefreshEmailList() subroutine, you will get the result below:

The solution above works for adding or removing rows, but you should be aware of two things:

• Refreshing the XML Feed using the refresh button will not trigger the event
• This solution does not keep old states, which means that, if one e-mail is removed and then re-added, information about that user might be lost.