Error in the code please debug it

Option Explicit
Dim vTableName As String

Sub generateUserXml()
'
' rights Macro
'
'
' Keyboard Shortcut: Ctrl+y
'
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim vStr As String
Dim vStr1 As String
Dim vXMLData As String
Dim vCellXML As String
Dim vTempStr As String
Dim stroldTPStart As String
Dim strnewTPStart As String


Dim arr() As String
Dim fso As New FileSystemObject
Dim fname As TextStream
Dim vTableNumber As Integer
Dim Vstring As String

vCellXML = Range("S1").Value
arr() = Split(xTract(vCellXML), "|")


'MsgBox Range("D12").Value
'For s = 1 To Range(column1).Rows.Count
' Vstring = Replace(vStr, "<%$" & CStr(s) & "%>", Trim(ChkDate(Range(column1).Cells(s).Value)))
'Next s

Dim h As Integer

'For h = 1 To 2
For i = 0 To UBound(arr)
vTableNumber = Mid(arr(i), InStr(arr(i), "_") + 1, Len(arr(i)) - InStr(arr(i), "_") + 1)
vStr = FindTags("<%" & CStr(arr(i)) & "%>", "<%END_" & vTableNumber & "%>", vCellXML)
vTempStr = vStr
vTableName = "table" & vTableNumber

For j = 1 To Range(vTableName).Rows.Count

For k = 1 To Range(vTableName).Columns.Count
vStr = Replace(vStr, "<%$" & CStr(k) & "%>", Trim(ChkDate(Range(vTableName).Cells(j, k).Value)))
Next k
vStr = Replace(vStr, "<%INSTANCE_1%>", GetChildsData(Range("T1").Value, 17, j))


vXMLData = vXMLData + vStr
vStr = vTempStr
'strnewTPStart = Range(vTableName).Cells(j, intCompareColumn).Value
'stroldTPStart = strnewTPStart
Next j

vXMLData = FindTags("<%BEGIN_HEADER%>", "<%END_HEADER%>", vCellXML) + vXMLData
vXMLData = vXMLData + FindTags("<%BEGIN_FOOTER%>", "<%END_FOOTER%>", vCellXML)
vXMLData = Replace(vXMLData, "&", "&amp;")
Set fname = fso.CreateTextFile("C:\CA\Clarity\CA_Clarity_v13_XOG\Custom\TD\Users\" & ActiveSheet.Name & i & ".xml", True)
fname.Write vXMLData
vXMLData = ""
Next i

'Next h
MsgBox "Output file saved at C:\CA\Clarity\CA_Clarity_v13_XOG\Custom\TD\Users\"


End Sub

Function GetChildsData(ByVal strTemplateXML As String, intCompareColumn As Integer, ByRef j As Integer) As String
Dim stroldResource As String
Dim strNewResource As String
Dim strResourceXML As String
Dim strResourcesXML As String
Dim k As Integer
Dim vStr1 As String



strResourcesXML = ""

' strnewTPStart = Range(vTableName).Cells(j, intCompareColumn).Value
' stroldTPStart = strnewTPStart

strNewResource = Range(vTableName).Cells(j, intCompareColumn).Value
stroldResource = strNewResource


Do While ((stroldResource = strNewResource) And j <= Range(vTableName).Rows.Count)
strResourceXML = strTemplateXML
For k = 1 To Range(vTableName).Columns.Count
strResourceXML = Replace(strResourceXML, "<%$" & CStr(k) & "%>", Trim(ChkDate(Range(vTableName).Cells(j, k).Value)))
Next k
vStr1 = Replace(vStr1, "<%INSTANCE_2%>", GetChildsData(Range("S1").Value, 18, k))
'If InStr(1, strResourceXML, "<%TIMESHEETENTRIES_1%>") > 0 Then
'strResourceXML = Replace(strResourceXML, "<%TIMESHEETENTRIES_1%>", GetChildsData(Range("O5").Value, 4, j))

'End If

strResourcesXML = strResourcesXML & strResourceXML
j = j + 1
stroldResource = strNewResource
strNewResource = Range(vTableName).Cells(j, intCompareColumn).Value
Loop
j = j - 1
GetChildsData = strResourcesXML
End Function

Function FindTags(vFirstStr As String, vSecondStr As String, vSearchIn As String) As String
Dim vFirstPos As Integer
Dim vSecondPos As Integer
vFirstPos = InStr(vSearchIn, vFirstStr)
vSecondPos = InStr(vSearchIn, vSecondStr)
FindTags = Trim(Mid(vSearchIn, vFirstPos + Len(vFirstStr), (vSecondPos - vFirstPos) - Len(vFirstStr)))
End Function
Function xTract(vSearchIn As String) As String
Dim vStrPos As Integer
Dim vPartStr As String
Dim vFullStr As String
Dim i As Integer

For i = 1 To Len(vSearchIn)
vStrPos = InStr(vStrPos + 1, vSearchIn, "<%BEGIN_")
If Not vStrPos > 0 Then Exit For
vPartStr = Mid(vSearchIn, vStrPos + 2, (InStr(vStrPos, vSearchIn, "%>") - vStrPos) - 2)
If Not (InStr(1, vPartStr, "HEADER") > 0 Or InStr(1, vPartStr, "FOOTER") > 0) Then
vFullStr = IIf(Trim(vFullStr) = "", vPartStr, vFullStr & "|" & vPartStr)
End If
Next
xTract = vFullStr
End Function

Function ChkDate(vStr As String) As String
If IsDate(vStr) And InStr(vStr, ".") = 0 Then
If InStr(UCase(ActiveSheet.Name), "SOW") > 0 Then
vStr = Format(vStr, "mm-dd-yyyy")
Else
vStr = Format(vStr, "mm-dd-yyyy")
End If
End If
ChkDate = vStr
End Function


Function GetChildsData1(ByVal strTemplateXML As String, intCompareColumn As Integer, ByRef j As Integer) As String
Dim stroldResource As String
Dim strNewResource As String
Dim strResourceXML As String
Dim strResourcesXML As String
Dim k As Integer



strResourcesXML = ""

' strnewTPStart = Range(vTableName).Cells(j, intCompareColumn).Value
' stroldTPStart = strnewTPStart

strNewResource = Range(vTableName).Cells(j, intCompareColumn).Value
stroldResource = strNewResource


Do While ((stroldResource = strNewResource) And j <= Range(vTableName).Rows.Count)
strResourceXML = strTemplateXML
For k = 1 To Range(vTableName).Columns.Count
strResourceXML = Replace(strResourceXML, "<%$" & CStr(k) & "%>", Trim(ChkDate(Range(vTableName).Cells(j, k).Value)))
Next k
'If InStr(1, strResourceXML, "<%TIMESHEETENTRIES_1%>") > 0 Then
'strResourceXML = Replace(strResourceXML, "<%TIMESHEETENTRIES_1%>", GetChildsData(Range("O5").Value, 4, j))

'End If

strResourcesXML = strResourcesXML & strResourceXML
j = j + 1
stroldResource = strNewResource
strNewResource = Range(vTableName).Cells(j, intCompareColumn).Value
Loop
j = j - 1
GetChildsData = strResourcesXML
End Function