How to auto-correct data in VBS for Excel with search for a match in an array?

Question

excel

There is an Excel file, where in some cells (let's say in B13:B22) the names of paints are entered. There is a script on VBS which will export the data to XML.
The operator fills in the names in the form something like this P485 or 485 or P485C
And you need to specifically PANTONE 485 C
Or he drives in FefBlue or Reflex
And you need to specifically PANTONE Reflex Blue C
There is a whole list of paints used with names as it should be.
But it seems to me that you just need to make a validation condition
How to do validation and data modification?
The code now is
Set objElem = objDoc.createElement("Ink")
objElem.setAttribute "ColorName", Cells(1, 2)

Answer 1

I think this should be done in the excel file itself in macros
On the event of a change in the corresponding cell, do a search in the list and change it again
For help with vbs, you need a more complete code

Answer 2

Those. a person types in cell 485, and the macro automatically substitutes PANTONE 485 C ?
How is it implemented?
Now I have a macro running through the macro launcher in Excel.
Now the code is like this:

Const strFilePath As String = "Y:\TEMP-Shuttle-IN\Blank_v1.xml"



Sub MyXLS2XML()


    Dim arRound As Integer
    Dim objDoc As MSXML2.DOMDocument
    Dim objNode As MSXML2.IXMLDOMNode
    Dim objRoot As MSXML2.IXMLDOMElement
    Dim objElem As MSXML2.IXMLDOMElement
    Dim ar As Variant
    Dim i As Integer
    
'    Для подсчёта новых форм
Dim val As String
Dim val1 As String
Dim r As Range
Dim SummNewForm As Integer
Set r = Range("E13:E22") 'диапазон ячеек
    
'Массив значений для сравнения
Dim MyArray
MyArray = Array("нов", "новая", "нов.")
 

    
    Set objDoc = New DOMDocument
    objDoc.resolveExternals = True
    Set objNode = objDoc.createProcessingInstruction("xml", "version='1.0' encoding='utf-8'")
    Set objNode = objDoc.InsertBefore(objNode, _
    objDoc.ChildNodes.Item(0))
    Set objRoot = objDoc.createElement("JOB")
    Set objDoc.DocumentElement = objRoot
    
      
             Set objElem = objDoc.createElement("JobNamber")
                  objElem.Text = Range("Номер_заказа")
                  objRoot.appendChild objElem
            
             Set objElem = objDoc.createElement("CustomerName")
                  objElem.Text = Range("Заказчик")
                  objRoot.appendChild objElem


             Set objElem = objDoc.createElement("Substrate")
                  objElem.Text = Range("Тип_материала")
                  objRoot.appendChild objElem

             Set objElem = objDoc.createElement("PrintTech")
                  objElem.Text = Range("Способ_печати")
                  objRoot.appendChild objElem

             Set objElem = objDoc.createElement("ICCprof")
                  objElem.Text = Range("ICC_профиль")
                  objRoot.appendChild objElem

             Set objElem = objDoc.createElement("CutTools")
                  objElem.Text = Range("Номер_штампа")
                  objRoot.appendChild objElem

             Set objElem = objDoc.createElement("LabelSize")
                  objElem.Text = Range("Размер_этикетки")
                  objRoot.appendChild objElem

             Set objElem = objDoc.createElement("LabelPart")
                  objElem.Text = Range("часть_этикетки")
                  objRoot.appendChild objElem

             Set objElem = objDoc.createElement("Winding")
                  objElem.Text = Range("Вариант_намотки")
                  objRoot.appendChild objElem

             Set objElem = objDoc.createElement("Designer")
                  objElem.Text = Range("Дизайнер")
                  objRoot.appendChild objElem

          
            
  i = 13
  Do
  
          
        Set objElem = objDoc.createElement("Ink")
            objElem.setAttribute "ID", Cells(i, 1)
            objElem.setAttribute "ColorName", Cells(i, 2)
            objElem.setAttribute "Frequency", Cells(i, 3)
            objElem.setAttribute "Angle", Cells(i, 4)
            objElem.setAttribute "InkParam", Cells(i, 5)
            objRoot.appendChild objElem
            

            
      i = i + 1
 Loop Until Cells(i, 1) = ""
           
'Подсчёт  количества новых форм. по условию val
           
           SummNewForm = Application.WorksheetFunction.CountIf(r, "*" & MyArray(0) & "*")
             Set objElem = objDoc.createElement("SummNewForm")
                  objElem.Text = SummNewForm
                  objRoot.appendChild objElem




            

        
    'Выполнение XSL-преобразования для добавления отступов в XML
    Call transformXML(objDoc)

    objDoc.Save strFilePath

      End Sub

'Процедура для придания XML читабельного вида (с отступами)
Sub transformXML(ByRef objDoc As Variant)

    'Cоздание объекта XSL
    Set xsl = CreateObject("MSXML2.DOMDocument")
    
    'Загрузка XSL из строки (не требует наличия отдельного XSL-файла)
    xsl.LoadXML ("<xsl:stylesheet version='1.0' xmlns:xsl='http://www.w3.org/1999/XSL/Transform'>" & vbCrLf & _
    "<xsl:output method='xml' version='1.0' encoding='UTF-8' indent='yes'/>" & vbCrLf & _
    "<xsl:template match='@*|node()'>" & vbCrLf & _
    "<xsl:copy>" & vbCrLf & _
    "<xsl:apply-templates select='@*|node()' />" & vbCrLf & _
    "</xsl:copy>" & vbCrLf & _
    "</xsl:template>" & vbCrLf & _
    "</xsl:stylesheet>")
    
    'Выполнение преобразования
    objDoc.transformNodeToObject xsl, objDoc

End Sub