DeclarationFile>
	<ID>
		<k2>5555.555</k2>
		<k7>2222.222</k7>
		<k15>33.333</k15>
	</ID>
	<ID>
		<k2>4444.444</k2>
		<k7>1111.111</k7>
		<k15>66.666</k15>
	</ID>
	<ID>
		<k2>333.33</k2>
		<k7>5.55</k7>
		<k15>7.77</k15>
	</ID>
</DeclarationFile>

Sub CreateXMLFile()
Dim MN_Row As Integer, MN_Column As Integer, MN_TEMP As String, mn_YesOrNo As Variant, mndefine_folder As String
Dim mn_XML_FileName As String, mn_XML_Record_Name As String, mn_LF As String, mn_rtc1 As Integer
Dim mn_first_range As String, mn_second_range As String, mn_tt As String, mn_FieldName(99) As String
mn_LF = Chr(10) & Chr(13)
mndefine_folder = "C:\"
mn_YesOrNo = MsgBox("Vajadzigs:" & mn_LF _
 & "1. XML File Name" & mn_LF _
 & "2. Record Tag Name" & mn_LF _
 & "3. A Range of Cells Containing Column Headers" & mn_LF _
 & "4. A Range of Cells Containing the Data Table." & mn_LF _
 & "If You Are Ready To Proceed, Click 'Yes'.", vbQuestion + vbYesNo, "CreateXMLFile")
If mn_YesOrNo = vbNo Then
 Debug.Print "User Canceled With 'No'"
 Exit Sub
End If
mn_XML_FileName = GapFiller(InputBox("1. Enter the XML File Name:", "CreateXMLFile", "xml_file"))
If Right(mn_XML_FileName, 4) <> ".xml" Then
 mn_XML_FileName = mn_XML_FileName & ".xml"
End If
mn_XML_Record_Name = GapFiller(InputBox("2. Enter The Record Tag Name:", "CreateXMLFile", "ID"))
mn_first_range = InputBox("3. Enter The Range of Cells Containing Column Headers:", "CreateXMLFile", "A1:B1")
If MN_DataRange(mn_first_range, 1) <> MN_DataRange(mn_first_range, 2) Then
  MsgBox "Error: Headers Must Be In The Same Row" & mn_LF & "Atcelts", vbOKOnly + vbCritical, "CreateXMLFile"
  Exit Sub
End If
MN_Row = MN_DataRange(mn_first_range, 1)
For MN_Column = MN_DataRange(mn_first_range, 3) To MN_DataRange(mn_first_range, 4)
 If Len(Cells(MN_Row, MN_Column).Value) = 0 Then
  MsgBox "Error: Header Contains Empty Cell" & mn_LF & "Canceled", vbOKOnly + vbCritical, "CreateXMLFile"
  Exit Sub
 End If
 mn_FieldName(MN_Column - MN_DataRange(mn_first_range, 3)) = GapFiller(Cells(MN_Row, MN_Column).Value)
Next MN_Column
mn_second_range = InputBox("4. Enter The Range of Cells Containing the Data Table:", "CreateXMLFile", "A2:B2")
If MN_DataRange(mn_first_range, 4) - MN_DataRange(mn_first_range, 3) <> MN_DataRange(mn_second_range, 4) - MN_DataRange(mn_second_range, 3) Then
  MsgBox "Error: There Are More Or Less Headers Than Columns of Data" & mn_LF & "Canceled", vbOKOnly + vbCritical, "CreateXMLFile"
  Exit Sub
End If
mn_rtc1 = MN_DataRange(mn_second_range, 3)
If InStr(1, mn_XML_FileName, ":\") = 0 Then
 mn_XML_FileName = mndefine_folder & mn_XML_FileName
End If
Open mn_XML_FileName For Output As #1
Print #1, "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "ISO-8859-1" & Chr(34) & "?>"
Print #1, "<DeclarationFile>"
For MN_Row = MN_DataRange(mn_second_range, 1) To MN_DataRange(mn_second_range, 2)
Print #1, "<" & mn_XML_Record_Name & ">"
  For MN_Column = mn_rtc1 To MN_DataRange(mn_second_range, 4)
    Print #1, "<" & mn_FieldName(MN_Column - mn_rtc1) & ">" & AmpersandEliminate(CheckForm(MN_Row, MN_Column)) & "</" & mn_FieldName(MN_Column - mn_rtc1) & ">"
    Next MN_Column
 Print #1, "</" & mn_XML_Record_Name & ">"
Next MN_Row
Print #1, "</DeclarationFile>"
Close #1
MsgBox mn_XML_FileName & " izveidots." & mn_LF & "Completed", vbOKOnly + vbInformation, "CreateXMLFile"
Debug.Print mn_XML_FileName & " saved"
End Sub
Function MN_DataRange(Rng_As_Text As String, MN_Item As Integer) As Integer
Dim MN_user_range As Range
Set MN_user_range = Range(Rng_As_Text)
Select Case MN_Item
 Case 1
 MN_DataRange = MN_user_range.Row
 Case 2
 MN_DataRange = MN_user_range.Row + MN_user_range.Rows.Count - 1
 Case 3
 MN_DataRange = MN_user_range.Column
 Case 4
 MN_DataRange = MN_user_range.Columns(MN_user_range.Columns.Count).Column
End Select
Exit Function
End Function
Function GapFiller(mn_my_Str As String) As String
Dim mn_Position As Integer
mn_Position = InStr(1, mn_my_Str, " ")
Do While mn_Position > 0
 Mid(mn_my_Str, mn_Position, 1) = "_"
 mn_Position = InStr(1, mn_my_Str, " ")
Loop
GapFiller = LCase(mn_my_Str)
End Function
Function CheckForm(mn_Row_Number As Integer, mn_Column_Number As Integer) As String
CheckForm = Cells(mn_Row_Number, mn_Column_Number).Value
If IsNumeric(Cells(mn_Row_Number, mn_Column_Number).Value) Then
 CheckForm = Format(Cells(mn_Row_Number, mn_Column_Number).Value, "#,##0 ;(#,##0)")
End If
If IsDate(Cells(mn_Row_Number, mn_Column_Number).Value) Then
 CheckForm = Format(Cells(mn_Row_Number, mn_Column_Number).Value, "dd mmm yy")
End If
End Function
Function AmpersandEliminate(mn_my_Str As String) As String
Dim mn_Position As Integer
mn_Position = InStr(1, mn_my_Str, "&")
Do While mn_Position > 0
 Mid(mn_my_Str, mn_Position, 1) = "+"
 mn_Position = InStr(1, mn_my_Str, "&")
Loop
AmpersandEliminate = mn_my_Str
End Function

Sub CreateXMLFile()
    Const THE_FOLDER As String = "C:\"
    Dim ws As Worksheet, rngData As Range, fName As String, rw As Long, col As Long
    Dim xml As String, tagId As String, tagVal As String, v
    
    If MsgBox("Vajadzigs:" & vbLf & "1. XML File Name" & vbLf & _
        "2. A Range of Cells Containing the Data Table (with headers)." & vbLf & _
        "If You Are Ready To Proceed, Click 'Yes'.", vbQuestion + vbYesNo, "CreateXMLFile") <> vbYes Then
            Debug.Print "User Canceled With 'No'"
            Exit Sub
    End If
    
    'would be better to use `Application.GetSaveAsFileName` here...
    fName = Application.GetSaveAsFilename(filefilter:="XML (*.xml),*.xml", _
                                 Title:="1. Select SaveAs name for XML file")
    
    
    On Error Resume Next 'ignore error if not range selected
    Set rngData = Application.InputBox("2. Select the range with data (include headers):", _
                                       "CreateXMLFile", Type:=8)
    On Error Resume Next 'stop ignoring error
    
    If rngData Is Nothing Then
        Debug.Print "User did not select a range"
        Exit Sub
    End If
    
    Open fName For Output As #1
    Print #1, "<?xml version=""1.0""  encoding=""ISO-8859-1""?>"
    Print #1, "<DeclarationFile>"
    
    For rw = 2 To rngData.Rows.Count
        tagId = rngData.Cells(rw, 1).Value
        Print #1, "<" & tagId & ">"
        For col = 2 To rngData.Columns.Count
            tagVal = rngData.Cells(1, col).Value
            v = rngData.Cells(rw, col).Value
            Print #1, "<" & tagVal & ">" & Replace(CheckForm(v), "&", "+") & "</" & tagVal & ">"
        Next col
        Print #1, "</" & tagId & ">"
    Next rw
    Print #1, "</DeclarationFile>"
    
    Open fName For Output As #1
    Close #1
    
    MsgBox fName & " izveidots." & vbLf & "Completed", vbOKOnly + vbInformation, "CreateXMLFile"
    Debug.Print fName & " saved"
End Sub
Function CheckForm(v) As String
    If IsNumeric(v) Then v = Format(v, "#,##0 ;(#,##0)")
    If IsDate(v) Then v = Format(v, "dd mmm yy")
    CheckForm = CStr(v)
End Function