<?xml version="1.0" encoding="utf-8"?>
<info>
    <cust ID="ID1" VAL="1111"/>
    <cust ID="ID2" VAL="2222"/>
    <cust ID="ID3" VAL="3333"/>
    <cust ID="ID4" VAL="4444"/>
    <cust ID="ID5" VAL="5555"/>
    <cust ID="ID6" VAL="6666"/>
    <cust ID="ID7" VAL="7777"/>
</info>

Public read As String
Sub LoadInfo()
    read = "OFF"
Dim xmlDoc As MSXML2.DOMDocument60
Set xmlDoc = New MSXML2.DOMDocument60
Dim xmlNode As MSXML2.IXMLDOMNode
Dim xmlNodes As MSXML2.IXMLDOMNodeList
Dim iRow As Integer
Dim nameBook As String
    nameBook = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)

    xmlDoc.Load (ActiveWorkbook.Path & "\" & nameBook & ".xml")
    Set xmlNodes = xmlDoc.SelectNodes("//info/cust")
    If xmlNodes.Length < 1 Then
        Exit Sub
    Else
        iRow = Range("Сводная_ID").Row
        For Each xmlNode In xmlNodes
            iRow = iRow + 1
            Call readItem(iRow, "ID", xmlNode)
            Call readItem(iRow, "VAL", xmlNode)
        Next
    End If
    read = "ON"
End Sub
Sub readItem(iRow, iName, iXmlNode)
    If Cells(iRow, Range("Сводная_" & iName).Column).text <> iXmlNode.Attributes.getNamedItem(iName).text Then
       Cells(iRow, Range("Сводная_" & iName).Column).Value = iXmlNode.Attributes.getNamedItem(iName).text
       Cells(iRow, Range("Сводная_" & iName).Column).Interior.Color = vbYellow
    Else
       Cells(iRow, Range("Сводная_" & iName).Column).Interior.Color = xlNone
    End If
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim iRow As Integer
    Dim iName As String
    Dim pZero As Integer
        pZero = Range("Сводная_ID").Row
    Dim lastCol As Integer
        lastCol = Cells(pZero, Columns.Count).End(xlToLeft).Column
    If read = "OFF" Then Exit Sub
    If Target.Column < lastCol And Target.Row > pZero Then
        Call wrXML(Target, pZero)
    End If
End Sub
Sub wrXML(iTarget, iZero)
    Dim xmlDoc As MSXML2.DOMDocument60
    Set xmlDoc = New MSXML2.DOMDocument60
    Dim xmlNode As MSXML2.IXMLDOMNode
    Dim xmlRoot As MSXML2.IXMLDOMNode
    Dim nameBook As String
        nameBook = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)
    xmlDoc.Load (ActiveWorkbook.Path & "\" & nameBook & ".xml")
           
    Set xmlRoot = xmlDoc.SelectSingleNode("//info/cust[@" & Split(Cells(iZero, 1).Name.Name, "_")(1) & "='" & Cells(iTarget.Row, 1).Value & "']")
    If Not xmlRoot Is Nothing Then
        Debug.Print "Bingo - Change Value"
        ' тут пытался записать новое значение в атрибут но не могу понять как
        ' перепробовал кучу вариантов...
    Else
        Debug.Print "No Bingo - Create New Node with Attr"
    End If
    
    xmlDoc.Save (ActiveWorkbook.Path & "\" & nameBook & ".xml")
End Sub