Macros to Import Excel based test suite and requirements into TestLink

' Author: Janagan
' Title: Macros to import requirement XML and Test suite XML into Test Link
' Note: Some of basic script is taken from googe from some other author's script. This is basically fully enhanced to cover
'    1. Test cases which has multiple steps
'    2. Test case contains more fields and more custom fileds
   

Sub genReqnXML()
' define variables
Dim lRow, lCol As Long
Dim duplicate As Boolean
Dim oneCell, onesMerged, reqRange As Range
Dim tsColCount, tcColCount, reqColCount, arrRow, temp As Integer
Dim arrReq(), arrReqTc() As Variant
Dim strTemp, xmlStr, xlsFileName, xmlTcFileName, xmlReqFileName As String
'Initializing Counts
reqColCount = 0
'Obtaining File Names
'Get the name of the excel file in which the requirements and testcases have been stored
'and store it as the XML Requirments File name and XML Test Case File Name
xlsFileName = ActiveWorkbook.FullName
xmlStr = Left(xlsFileName, InStr(xlsFileName, "."))
xmlReqFileName = Left(xlsFileName, Len(xlsFileName) - 4) & "_Req.xml"
'Get the last row and last column in the list
lRow = lastRow()
arrRow = lRow - 2
lCol = lastColumn()
'Count the columns for test suite, test cases and requirements and identify if any custom fields are present
'Custom fields import for other than test cases is NOT supported in TestLink
With Sheets(1)
    For Each oneCell In Range(Cells(1, 1), Cells(1, lCol))
        If oneCell.MergeCells Then
           If oneCell.Text = "Requirements" Then
              Set reqRange = oneCell.MergeArea
              reqColCount = oneCell.MergeArea.Count
            End If
        Else
           If oneCell.Text = "Requirements" Then
              reqColCount = 1
            End If
        End If
    Next oneCell
End With
'Define array sizes to store the contents
If reqColCount <> 0 Then
  ReDim Preserve arrReqTc(0 To arrRow, 1 To reqColCount) As Variant
  ReDim Preserve arrReq(0 To arrRow, 1 To reqColCount) As Variant
End If

'Collect the Requirements associated with Test Cases in an Array
If reqColCount <> 0 Then
  With Sheets(1)
    For Each oneCell In reqRange
      Select Case oneCell.Offset(1, 0).Text
      Case "Spec Title"
        arrReqTc(0, 1) = "Spec Title"
        For irow = 2 To lRow - 1
          arrReqTc(irow - 1, 1) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "Document ID"
        arrReqTc(0, 2) = "Document ID"
        For irow = 2 To lRow - 1
          arrReqTc(irow - 1, 2) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "Req Title"
        arrReqTc(0, 3) = "Req Title"
        For irow = 2 To lRow - 1
          arrReqTc(irow - 1, 3) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "Description"
        arrReqTc(0, 4) = "Description"
        For irow = 2 To lRow - 1
          arrReqTc(irow - 1, 4) = oneCell.Offset(irow, 0).Text
        Next irow
      End Select
    Next oneCell
  End With
End If

'Remove the duplicate listings of requirements and store the unique listings in an array
If reqColCount <> 0 Then
    temp = 0
    For irow = 0 To arrRow
      duplicate = False
      For jRow = 0 To irow
        If arrReqTc(irow, 2) = arrReq(jRow, 2) Then
          duplicate = True
          Exit For
        End If
      Next jRow
      If duplicate = False Then
        arrReq(temp, 1) = arrReqTc(irow, 1)
        arrReq(temp, 2) = arrReqTc(irow, 2)
        If reqColCount > 2 Then
          arrReq(temp, 3) = arrReqTc(irow, 3)
        End If
        If reqColCount > 3 Then
          arrReq(temp, 4) = arrReqTc(irow, 4)
        End If
        temp = temp + 1
      End If
    Next irow
  Else
    With Sheets(1)
      For Each oneCell In reqRange
        Select Case oneCell.Offset(1, 0).Text
        Case "Spec Title"
          arrReq(0, 1) = "Spec Title"
          For irow = 2 To lRow - 1
            arrReq(irow - 1, 1) = oneCell.Offset(irow, 0).Text
          Next irow
        Case "Document ID"
          arrReq(0, 2) = "Document ID"
          For irow = 2 To lRow - 1
            arrReq(irow - 1, 2) = oneCell.Offset(irow, 0).Text
          Next irow
        Case "Req Title"
          arrReq(0, 3) = "Req Title"
          For irow = 2 To lRow - 1
            arrReq(irow - 1, 3) = oneCell.Offset(irow, 0).Text
          Next irow
        Case "Description"
          arrReq(0, 4) = "Description"
          For irow = 2 To lRow - 1
            arrReq(irow - 1, 4) = oneCell.Offset(irow, 0).Text
          Next irow
        End Select
      Next oneCell
  End With
  End If
'Create the Requirements XML file
If reqColCount <> 0 Then
  Open xmlReqFileName For Output As #1
  Print #1, "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "UTF-8" & Chr(34) & "?>"
  Print #1, "<requirements>"
 
  For irow = 1 To arrRow
    temp = 0
    For iCol = 1 To reqColCount
      If arrReq(irow, iCol) <> "" Then
        Select Case arrReq(0, iCol)
          Case "Spec Title"
            'Do Nothing
          Case "Document ID"
            temp = 1
            Print #1, "    <requirement>"
            xmlStr = "        <docid><![CDATA[" & arrReq(irow, iCol) & "]]></docid>"
            Print #1, xmlStr
          Case "Req Title"
            xmlStr = "        <title><![CDATA[" & arrReq(irow, iCol) & "]]></title>"
            Print #1, xmlStr
          Case "Description"
            xmlStr = "        <description><![CDATA[" & arrReq(irow, iCol) & "]]></description>"
            Print #1, xmlStr
          Case Else
            'Do Nothing
          End Select
        End If
    Next iCol
    If temp <> 0 Then
      Print #1, "    </requirement>"
    End If
  Next irow
  Print #1, "</requirements>"
  Close #1
End If
End Sub
Sub genTcXML()
Dim lRow, lCol As Long
Dim duplicate As Boolean
Dim oneCell, onesMerged, tsRange, tcRange, reqRange As Range
Dim tsColCount, tcColCount, reqColCount, tcCFCount, arrRow, temp As Integer
Dim arrReq(), arrTS(), arrTc(), arrReqTc(), arrTcCF() As Variant
Dim strTemp, xmlStr, xlsFileName, xmlTcFileName, xmlReqFileName As String
'Initializing Counts
tsColCount = 0
tcColCount = 0
reqColCount = 0
tcCFCount = 0
'Obtaining File Names
'Get the name of the excel file in which the requirements and testcases have been stored
'and store it as the XML Requirments File name and XML Test Case File Name
xlsFileName = ActiveWorkbook.FullName
xmlStr = Left(xlsFileName, InStr(xlsFileName, "."))
xmlTcFileName = Left(xlsFileName, Len(xlsFileName) - 4) & "_Tc.xml"
'Get the last row and last column in the list
lRow = lastRow()
arrRow = lRow - 2
lCol = lastColumn()
'Count the columns for test suite, test cases and requirements and identify if any custom fields are present
'Custom fields import for other than test cases is NOT supported in TestLink
With Sheets(1)
    For Each oneCell In Range(Cells(1, 1), Cells(1, lCol))
        If oneCell.MergeCells Then
            If oneCell.Text = "Test Suite" Then
              Set tsRange = oneCell.MergeArea
              tsColCount = oneCell.MergeArea.Count
            ElseIf oneCell.Text = "Test Case" Then
              Set tcRange = oneCell.MergeArea
              tcColCount = oneCell.MergeArea.Count
            ElseIf oneCell.Text = "Requirements" Then
              Set reqRange = oneCell.MergeArea
              reqColCount = oneCell.MergeArea.Count
            End If
        Else
          If oneCell.Text = "Test Suite" Then
              tsColCount = 1
            ElseIf oneCell.Text = "Test Case" Then
              tcColCount = 1
            ElseIf oneCell.Text = "Requirements" Then
              reqColCount = 1
            End If
        End If
    Next oneCell
End With
'Define array sizes to store the contents
If tsColCount <> 0 And tcColCount <> 0 Then
  ReDim Preserve arrTS(0 To arrRow, 1 To tsColCount) As Variant
End If
If tcColCount <> 0 Then
  ReDim Preserve arrTc(0 To arrRow, 1 To tcColCount) As Variant
End If
If tcColCount <> 0 And reqColCount <> 0 Then
  ReDim Preserve arrReqTc(0 To arrRow, 1 To reqColCount) As Variant
End If
'Collect the Requirements associated with Test Cases in an Array
If reqColCount <> 0 And tcColCount <> 0 Then
  With Sheets(1)
    For Each oneCell In reqRange
      Select Case oneCell.Offset(1, 0).Text
      Case "Spec Title"
        arrReqTc(0, 1) = "Spec Title"
        For irow = 2 To lRow - 1
          arrReqTc(irow - 1, 1) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "Document ID"
        arrReqTc(0, 2) = "Document ID"
        For irow = 2 To lRow - 1
          arrReqTc(irow - 1, 2) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "Req Title"
        arrReqTc(0, 3) = "Req Title"
        For irow = 2 To lRow - 1
          arrReqTc(irow - 1, 3) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "Description"
        arrReqTc(0, 4) = "Description"
        For irow = 2 To lRow - 1
          arrReqTc(irow - 1, 4) = oneCell.Offset(irow, 0).Text
        Next irow
      End Select
    Next oneCell
  End With
End If
'Collect the Test Suite in an Array
If tsColCount <> 0 Then
  With Sheets(1)
    For Each oneCell In tsRange
      Select Case oneCell.Offset(1, 0).Text
      Case "Name"
        arrTS(0, 1) = "Name"
        For irow = 2 To lRow - 1
          arrTS(irow - 1, 1) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "Details"
        arrTS(0, 2) = "Details"
        For irow = 2 To lRow - 1
          arrTS(irow - 1, 2) = oneCell.Offset(irow, 0).Text
        Next irow
      End Select
    Next oneCell
  End With
End If
'Collect the Test Cases in an Array
If tcColCount <> 0 Then
  With Sheets(1)
    For Each oneCell In tcRange
      Select Case oneCell.Offset(1, 0).Text
      Case "TC#"
        arrTc(0, 2) = "TC#"
        For irow = 2 To lRow - 1
          arrTc(irow - 1, 2) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "Name"
        arrTc(0, 1) = "Name"
        For irow = 2 To lRow - 1
          arrTc(irow - 1, 1) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "Summary"
        arrTc(0, 3) = "Summary"
        For irow = 2 To lRow - 1
          arrTc(irow - 1, 3) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "PreConditions"
        arrTc(0, 4) = "PreConditions"
        For irow = 2 To lRow - 1
          arrTc(irow - 1, 4) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "ExecutionType"
        arrTc(0, 5) = "ExecutionType"
        For irow = 2 To lRow - 1
          arrTc(irow - 1, 5) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "Importance"
        arrTc(0, 6) = "Importance"
        For irow = 2 To lRow - 1
          arrTc(irow - 1, 6) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "Steps"
        arrTc(0, 7) = "Steps"
        For irow = 2 To lRow - 1
          arrTc(irow - 1, 7) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "Expected Results"
        arrTc(0, 8) = "Expected Results"
        For irow = 2 To lRow - 1
          arrTc(irow - 1, 8) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "StepExecutionType"
        arrTc(0, 9) = "StepExecutionType"
        For irow = 2 To lRow - 1
          arrTc(irow - 1, 9) = oneCell.Offset(irow, 0).Text
        Next irow
      Case Else
        'Count the number of custom fields to import
        tcCFCount = tcCFCount + 1
      End Select
    Next oneCell
  End With
 
  ReDim Preserve arrTc(0 To arrRow, 1 To tcColCount - tcCFCount) As Variant
  'Collect the Custom fields for Test Cases in an Array
  If tcCFCount <> 0 Then
 
    temp = arrRow * tcCFCount
   
    ReDim Preserve arrTcCF(0 To temp, 1 To 3) As Variant
    arrTcCF(0, 1) = "TC#"
    arrTcCF(0, 2) = "Name"
    arrTcCF(0, 3) = "Value"
 
    temp = 0
 
    With Sheets(1)
      For Each oneCell In tcRange
        Select Case oneCell.Offset(1, 0).Text
          Case "TC#"
            For i = 1 To tcCFCount
              For irow = 2 To lRow - 1
                arrTcCF(irow - 1 + temp, 1) = oneCell.Offset(irow, 0).Text
              Next irow
              temp = temp + lRow - 2
            Next i
            temp = 0
          Case "Name"
            'Do Nothing
          Case "Summary"
            'Do Nothing
          Case "PreConditions"
            'Do Nothing
          Case "ExecutionType"
            'Do Nothing
          Case "Importance"
            'Do Nothing
          Case "StepExecutionType"
            'Do Nothing
          Case "Steps"
            'Do Nothing
          Case "Expected Results"
            'Do Nothing
          Case Else
            For irow = 2 To lRow - 1
              arrTcCF(irow - 1 + temp, 2) = oneCell.Offset(1, 0).Text
              arrTcCF(irow - 1 + temp, 3) = oneCell.Offset(irow, 0).Text
            Next irow
            temp = temp + lRow - 2
          End Select
      Next oneCell
    End With
  End If
End If

'Create the Test Cases XML file
If tcColCount <> 0 Then
  Open xmlTcFileName For Output As #2
  Print #2, "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "UTF-8" & Chr(34) & "?>"
 
  If tsColCount <> 0 Then
    Print #2, "<testsuite name=" & Chr(34) & Chr(34) & ">"
    Print #2, "    <details><![CDATA[]]></details>"
  Else
    Print #2, "<testcases>"
  End If
 
  strTemp = ""
  tempStep = 1
  ' xml for test case for each rows -----------------------
  For irow = 1 To arrRow
 
    temp = 0
   
    If tsColCount <> 0 Then
      If arrTS(irow, 1) <> "" Then
        xmlStr = "    <testsuite name=" & Chr(34) & arrTS(irow, 1) & Chr(34) & ">"
        Print #2, xmlStr
        xmlStr = "        <details><![CDATA[" & arrTS(irow, 2) & "]]></details>"
        Print #2, xmlStr
        strTemp = "    "
      End If
    End If
   
    For iCol = 1 To tcColCount - tcCFCount
      If arrTc(irow, iCol) <> "" Then
        Select Case arrTc(0, iCol)
          Case "Name"
           If arrTc(irow, iCol) <> "" Then
            xmlStr = strTemp & "    <testcase name=" & Chr(34) & arrTc(irow, iCol) & Chr(34) & ">"
            Print #2, xmlStr
           End If
          Case "TC#"
           If arrTc(irow, iCol) <> "" Then
            xmlStr = strTemp & "        <node_order><![CDATA[" & arrTc(irow, iCol) & "]]></node_order>"
            Print #2, xmlStr
           End If
          Case "Summary"
           If arrTc(irow, iCol) <> "" Then
            xmlStr = strTemp & "        <summary><![CDATA[" & arrTc(irow, iCol) & "]]></summary>"
            Print #2, xmlStr
           End If
          Case "PreConditions"
           If arrTc(irow, iCol) <> "" Then
            xmlStr = strTemp & "        <preconditions><![CDATA[" & arrTc(irow, iCol) & "]]></preconditions>"
            Print #2, xmlStr
           End If
          Case "ExecutionType"
           If arrTc(irow, iCol) <> "" Then
            xmlStr = strTemp & "        <execution_type><![CDATA[" & arrTc(irow, iCol) & "]]></execution_type>"
            Print #2, xmlStr
           End If
          Case "Importance"
           If arrTc(irow, iCol) <> "" Then
              xmlStr = strTemp & "        <importance><![CDATA[" & arrTc(irow, iCol) & "]]></importance>"
              Print #2, xmlStr
            'Get the custom fields if any
              temp = 0
              If tcCFCount <> 0 Then
                For i = 1 To arrRow * tcCFCount
                    If arrTc(irow, 2) = arrTcCF(i, 1) Then
                        If arrTcCF(i, 2) <> "" And arrTcCF(i, 3) <> "" Then
                            If temp = 0 Then
                                xmlStr = strTemp & "        <custom_fields>"
                                Print #2, xmlStr
                                temp = 1
                            End If
                         xmlStr = strTemp & "            <custom_field>"
                         Print #2, xmlStr
                         xmlStr = strTemp & "                <name>" & arrTcCF(i, 2) & "</name>"
                         Print #2, xmlStr
                         xmlStr = strTemp & "                <value>" & arrTcCF(i, 3) & "</value>"
                         Print #2, xmlStr
                         xmlStr = strTemp & "            </custom_field>"
                         Print #2, xmlStr
                        End If
                    End If
                Next i
                    If temp = 1 Then
                     xmlStr = strTemp & "        </custom_fields>"
                     Print #2, xmlStr
                     temp = 0
                    End If
                End If
             'Get the requirements associated with test cases
              If reqColCount <> 0 Then
                 'For i = 1 To arrRow
                   ' If arrTc(irow, 2) = arrReqTc(i, 2) Then
                        If arrReqTc(irow, 1) <> "" And arrReqTc(irow, 2) <> "" Then
                            xmlStr = strTemp & "        <requirements>"
                            Print #2, xmlStr
                            xmlStr = strTemp & "            <requirement>"
                            Print #2, xmlStr
                            xmlStr = strTemp & "                <req_spec_title>" & arrReqTc(irow, 1) & "</req_spec_title>"
                            Print #2, xmlStr
                            xmlStr = strTemp & "                <doc_id>" & arrReqTc(irow, 2) & "</doc_id>"
                            Print #2, xmlStr
                            xmlStr = strTemp & "            </requirement>"
                            Print #2, xmlStr
                            xmlStr = strTemp & "        </requirements>"
                            Print #2, xmlStr
                        End If
                 '   End If
                'Next i
               End If
            End If
           Case "Steps"
            If arrTc(irow, iCol - 1) <> "" Then
            xmlStr = strTemp & "        <steps>"
            Print #2, xmlStr
            End If
            xmlStr = strTemp & "        <step>"
            Print #2, xmlStr
            xmlStr = strTemp & "            <step_number><![CDATA[" & tempStep & "]]></step_number>"
            Print #2, xmlStr
            xmlStr = strTemp & "            <actions><![CDATA[" & arrTc(irow, iCol) & "]]></actions>"
            Print #2, xmlStr
          Case "Expected Results"
            xmlStr = strTemp & "            <expectedresults><![CDATA[" & arrTc(irow, iCol) & "]]></expectedresults>"
            Print #2, xmlStr
          Case "StepExecutionType"
            xmlStr = strTemp & "            <execution_type><![CDATA[" & arrTc(irow, iCol) & "]]></execution_type>"
            Print #2, xmlStr
            xmlStr = strTemp & "        </step>"
            Print #2, xmlStr
            tempStep = tempStep + 1
            If irow < arrRow Then
             If arrTc(irow + 1, iCol - 3) <> "" Then
              xmlStr = strTemp & "        </steps>"
              Print #2, xmlStr
              tempStep = 1
             End If
            Else
             xmlStr = strTemp & "        </steps>"
             Print #2, xmlStr
             tempStep = 1
            End If
          End Select
        End If
    Next iCol
     If irow < arrRow Then
         If arrTc(irow + 1, 1) <> "" Then
           xmlStr = strTemp & "    </testcase>"
           Print #2, xmlStr
         End If
     Else
           xmlStr = strTemp & "    </testcase>"
           Print #2, xmlStr
      End If
    If tsColCount <> 0 Then
      If irow < arrRow Then
        If arrTS(irow + 1, 1) <> "" Then
            Print #2, "    </testsuite>"
        End If
      Else
        Print #2, "    </testsuite>"
      End If
    End If
  Next irow
   
  If tsColCount <> 0 Then
    Print #2, "</testsuite>"
  Else
    Print #2, "</testcases>"
  End If
  Close #2
End If
End Sub
Sub genReqANDTcXML()
Dim lRow, lCol As Long
Dim duplicate As Boolean
Dim oneCell, onesMerged, tsRange, tcRange, reqRange As Range
Dim tsColCount, tcColCount, reqColCount, tcCFCount, arrRow, temp As Integer
Dim arrReq(), arrTS(), arrTc(), arrReqTc(), arrTcCF() As Variant
Dim strTemp, xmlStr, xlsFileName, xmlTcFileName, xmlReqFileName As String
'Initializing Counts
tsColCount = 0
tcColCount = 0
reqColCount = 0
tcCFCount = 0
'Obtaining File Names
'Get the name of the excel file in which the requirements and testcases have been stored
'and store it as the XML Requirments File name and XML Test Case File Name
xlsFileName = ActiveWorkbook.FullName
xmlStr = Left(xlsFileName, InStr(xlsFileName, "."))
xmlReqFileName = Left(xlsFileName, Len(xlsFileName) - 4) & "_Req.xml"
xmlTcFileName = Left(xlsFileName, Len(xlsFileName) - 4) & "_Tc.xml"
'Get the last row and last column in the list
lRow = lastRow()
arrRow = lRow - 2
lCol = lastColumn()
'Count the columns for test suite, test cases and requirements and identify if any custom fields are present
'Custom fields import for other than test cases is NOT supported in TestLink
With Sheets(1)
    For Each oneCell In Range(Cells(1, 1), Cells(1, lCol))
        If oneCell.MergeCells Then
            If oneCell.Text = "Test Suite" Then
              Set tsRange = oneCell.MergeArea
              tsColCount = oneCell.MergeArea.Count
            ElseIf oneCell.Text = "Test Case" Then
              Set tcRange = oneCell.MergeArea
              tcColCount = oneCell.MergeArea.Count
            ElseIf oneCell.Text = "Requirements" Then
              Set reqRange = oneCell.MergeArea
              reqColCount = oneCell.MergeArea.Count
            End If
        Else
          If oneCell.Text = "Test Suite" Then
              tsColCount = 1
            ElseIf oneCell.Text = "Test Case" Then
              tcColCount = 1
            ElseIf oneCell.Text = "Requirements" Then
              reqColCount = 1
            End If
        End If
    Next oneCell
End With
'Define array sizes to store the contents
If reqColCount <> 0 Then
  ReDim Preserve arrReq(0 To arrRow, 1 To reqColCount) As Variant
End If
If tsColCount <> 0 And tcColCount <> 0 Then
  ReDim Preserve arrTS(0 To arrRow, 1 To tsColCount) As Variant
End If
If tcColCount <> 0 Then
  ReDim Preserve arrTc(0 To arrRow, 1 To tcColCount) As Variant
End If
If tcColCount <> 0 And reqColCount <> 0 Then
  ReDim Preserve arrReqTc(0 To arrRow, 1 To reqColCount) As Variant
End If
'Collect the Requirements associated with Test Cases in an Array
If reqColCount <> 0 And tcColCount <> 0 Then
  With Sheets(1)
    For Each oneCell In reqRange
      Select Case oneCell.Offset(1, 0).Text
      Case "Spec Title"
        arrReqTc(0, 1) = "Spec Title"
        For irow = 2 To lRow - 1
          arrReqTc(irow - 1, 1) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "Document ID"
        arrReqTc(0, 2) = "Document ID"
        For irow = 2 To lRow - 1
          arrReqTc(irow - 1, 2) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "Req Title"
        arrReqTc(0, 3) = "Req Title"
        For irow = 2 To lRow - 1
          arrReqTc(irow - 1, 3) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "Description"
        arrReqTc(0, 4) = "Description"
        For irow = 2 To lRow - 1
          arrReqTc(irow - 1, 4) = oneCell.Offset(irow, 0).Text
        Next irow
      End Select
    Next oneCell
  End With
End If
'Collect the Test Suite in an Array
If tsColCount <> 0 Then
  With Sheets(1)
    For Each oneCell In tsRange
      Select Case oneCell.Offset(1, 0).Text
      Case "Name"
        arrTS(0, 1) = "Name"
        For irow = 2 To lRow - 1
          arrTS(irow - 1, 1) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "Details"
        arrTS(0, 2) = "Details"
        For irow = 2 To lRow - 1
          arrTS(irow - 1, 2) = oneCell.Offset(irow, 0).Text
        Next irow
      End Select
    Next oneCell
  End With
End If
'Collect the Test Cases in an Array
If tcColCount <> 0 Then
  With Sheets(1)
    For Each oneCell In tcRange
      Select Case oneCell.Offset(1, 0).Text
      Case "TC#"
        arrTc(0, 2) = "TC#"
        For irow = 2 To lRow - 1
          arrTc(irow - 1, 2) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "Name"
        arrTc(0, 1) = "Name"
        For irow = 2 To lRow - 1
          arrTc(irow - 1, 1) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "Summary"
        arrTc(0, 3) = "Summary"
        For irow = 2 To lRow - 1
          arrTc(irow - 1, 3) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "PreConditions"
        arrTc(0, 4) = "PreConditions"
        For irow = 2 To lRow - 1
          arrTc(irow - 1, 4) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "ExecutionType"
        arrTc(0, 5) = "ExecutionType"
        For irow = 2 To lRow - 1
          arrTc(irow - 1, 5) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "Importance"
        arrTc(0, 6) = "Importance"
        For irow = 2 To lRow - 1
          arrTc(irow - 1, 6) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "Steps"
        arrTc(0, 7) = "Steps"
        For irow = 2 To lRow - 1
          arrTc(irow - 1, 7) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "Expected Results"
        arrTc(0, 8) = "Expected Results"
        For irow = 2 To lRow - 1
          arrTc(irow - 1, 8) = oneCell.Offset(irow, 0).Text
        Next irow
      Case "StepExecutionType"
        arrTc(0, 9) = "StepExecutionType"
        For irow = 2 To lRow - 1
          arrTc(irow - 1, 9) = oneCell.Offset(irow, 0).Text
        Next irow
      Case Else
        'Count the number of custom fields to import
        tcCFCount = tcCFCount + 1
      End Select
    Next oneCell
  End With
 
  ReDim Preserve arrTc(0 To arrRow, 1 To tcColCount - tcCFCount) As Variant
  'Collect the Custom fields for Test Cases in an Array
  If tcCFCount <> 0 Then
 
    temp = arrRow * tcCFCount
   
    ReDim Preserve arrTcCF(0 To temp, 1 To 3) As Variant
    arrTcCF(0, 1) = "TC#"
    arrTcCF(0, 2) = "Name"
    arrTcCF(0, 3) = "Value"
 
    temp = 0
 
    With Sheets(1)
      For Each oneCell In tcRange
        Select Case oneCell.Offset(1, 0).Text
          Case "TC#"
            For i = 1 To tcCFCount
              For irow = 2 To lRow - 1
                arrTcCF(irow - 1 + temp, 1) = oneCell.Offset(irow, 0).Text
              Next irow
              temp = temp + lRow - 2
            Next i
            temp = 0
          Case "Name"
            'Do Nothing
          Case "Summary"
            'Do Nothing
          Case "PreConditions"
            'Do Nothing
          Case "ExecutionType"
            'Do Nothing
          Case "Importance"
            'Do Nothing
          Case "StepExecutionType"
            'Do Nothing
          Case "Steps"
            'Do Nothing
          Case "Expected Results"
            'Do Nothing
          Case Else
            For irow = 2 To lRow - 1
              arrTcCF(irow - 1 + temp, 2) = oneCell.Offset(1, 0).Text
              arrTcCF(irow - 1 + temp, 3) = oneCell.Offset(irow, 0).Text
            Next irow
            temp = temp + lRow - 2
          End Select
      Next oneCell
    End With
  End If
End If
'Remove the duplicate listings of requirements and store the unique listings in an array
If reqColCount <> 0 Then
  If tcColCount <> 0 Then
    temp = 0
    For irow = 0 To arrRow
      duplicate = False
      For jRow = 0 To irow
        If arrReqTc(irow, 2) = arrReq(jRow, 2) Then
          duplicate = True
          Exit For
        End If
      Next jRow
      If duplicate = False Then
        arrReq(temp, 1) = arrReqTc(irow, 1)
        arrReq(temp, 2) = arrReqTc(irow, 2)
        If reqColCount > 2 Then
          arrReq(temp, 3) = arrReqTc(irow, 3)
        End If
        If reqColCount > 3 Then
          arrReq(temp, 4) = arrReqTc(irow, 4)
        End If
        temp = temp + 1
      End If
    Next irow
  Else
    With Sheets(1)
      For Each oneCell In reqRange
        Select Case oneCell.Offset(1, 0).Text
        Case "Spec Title"
          arrReq(0, 1) = "Spec Title"
          For irow = 2 To lRow - 1
            arrReq(irow - 1, 1) = oneCell.Offset(irow, 0).Text
          Next irow
        Case "Document ID"
          arrReq(0, 2) = "Document ID"
          For irow = 2 To lRow - 1
            arrReq(irow - 1, 2) = oneCell.Offset(irow, 0).Text
          Next irow
        Case "Req Title"
          arrReq(0, 3) = "Req Title"
          For irow = 2 To lRow - 1
            arrReq(irow - 1, 3) = oneCell.Offset(irow, 0).Text
          Next irow
        Case "Description"
          arrReq(0, 4) = "Description"
          For irow = 2 To lRow - 1
            arrReq(irow - 1, 4) = oneCell.Offset(irow, 0).Text
          Next irow
        End Select
      Next oneCell
  End With
  End If
End If
'Create the Requirements XML file
If reqColCount <> 0 Then
  Open xmlReqFileName For Output As #1
  Print #1, "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "UTF-8" & Chr(34) & "?>"
  Print #1, "<requirements>"
 
  For irow = 1 To arrRow
    temp = 0
    For iCol = 1 To reqColCount
      If arrReq(irow, iCol) <> "" Then
        Select Case arrReq(0, iCol)
          Case "Spec Title"
            'Do Nothing
          Case "Document ID"
            temp = 1
            Print #1, "    <requirement>"
            xmlStr = "        <docid><![CDATA[" & arrReq(irow, iCol) & "]]></docid>"
            Print #1, xmlStr
          Case "Req Title"
            xmlStr = "        <title><![CDATA[" & arrReq(irow, iCol) & "]]></title>"
            Print #1, xmlStr
          Case "Description"
            xmlStr = "        <description><![CDATA[" & arrReq(irow, iCol) & "]]></description>"
            Print #1, xmlStr
          Case Else
            'Do Nothing
          End Select
        End If
    Next iCol
    If temp <> 0 Then
      Print #1, "    </requirement>"
    End If
  Next irow
  Print #1, "</requirements>"
  Close #1
End If
'Create the Test Cases XML file
If tcColCount <> 0 Then
  Open xmlTcFileName For Output As #2
  Print #2, "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "UTF-8" & Chr(34) & "?>"
 
  If tsColCount <> 0 Then
    Print #2, "<testsuite name=" & Chr(34) & Chr(34) & ">"
    Print #2, "    <details><![CDATA[]]></details>"
  Else
    Print #2, "<testcases>"
  End If
 
  strTemp = ""
  tempStep = 1
  ' xml for test case for each rows -----------------------
  For irow = 1 To arrRow
 
    temp = 0
   
    If tsColCount <> 0 Then
      If arrTS(irow, 1) <> "" Then
        xmlStr = "    <testsuite name=" & Chr(34) & arrTS(irow, 1) & Chr(34) & ">"
        Print #2, xmlStr
        xmlStr = "        <details><![CDATA[" & arrTS(irow, 2) & "]]></details>"
        Print #2, xmlStr
        strTemp = "    "
      End If
    End If
   
    For iCol = 1 To tcColCount - tcCFCount
      If arrTc(irow, iCol) <> "" Then
        Select Case arrTc(0, iCol)
          Case "Name"
           If arrTc(irow, iCol) <> "" Then
            xmlStr = strTemp & "    <testcase name=" & Chr(34) & arrTc(irow, iCol) & Chr(34) & ">"
            Print #2, xmlStr
           End If
          Case "TC#"
           If arrTc(irow, iCol) <> "" Then
            xmlStr = strTemp & "        <node_order><![CDATA[" & arrTc(irow, iCol) & "]]></node_order>"
            Print #2, xmlStr
           End If
          Case "Summary"
           If arrTc(irow, iCol) <> "" Then
            xmlStr = strTemp & "        <summary><![CDATA[" & arrTc(irow, iCol) & "]]></summary>"
            Print #2, xmlStr
           End If
          Case "PreConditions"
           If arrTc(irow, iCol) <> "" Then
            xmlStr = strTemp & "        <preconditions><![CDATA[" & arrTc(irow, iCol) & "]]></preconditions>"
            Print #2, xmlStr
           End If
          Case "ExecutionType"
           If arrTc(irow, iCol) <> "" Then
            xmlStr = strTemp & "        <execution_type><![CDATA[" & arrTc(irow, iCol) & "]]></execution_type>"
            Print #2, xmlStr
           End If
          Case "Importance"
           If arrTc(irow, iCol) <> "" Then
              xmlStr = strTemp & "        <importance><![CDATA[" & arrTc(irow, iCol) & "]]></importance>"
              Print #2, xmlStr
            'Get the custom fields if any
              temp = 0
              If tcCFCount <> 0 Then
                For i = 1 To arrRow * tcCFCount
                    If arrTc(irow, 2) = arrTcCF(i, 1) Then
                        If arrTcCF(i, 2) <> "" And arrTcCF(i, 3) <> "" Then
                            If temp = 0 Then
                                xmlStr = strTemp & "        <custom_fields>"
                                Print #2, xmlStr
                                temp = 1
                            End If
                         xmlStr = strTemp & "            <custom_field>"
                         Print #2, xmlStr
                         xmlStr = strTemp & "                <name>" & arrTcCF(i, 2) & "</name>"
                         Print #2, xmlStr
                         xmlStr = strTemp & "                <value>" & arrTcCF(i, 3) & "</value>"
                         Print #2, xmlStr
                         xmlStr = strTemp & "            </custom_field>"
                         Print #2, xmlStr
                        End If
                    End If
                Next i
                    If temp = 1 Then
                     xmlStr = strTemp & "        </custom_fields>"
                     Print #2, xmlStr
                     temp = 0
                    End If
                End If
             'Get the requirements associated with test cases
              If reqColCount <> 0 Then
                 'For i = 1 To arrRow
                   ' If arrTc(irow, 2) = arrReqTc(i, 2) Then
                        If arrReqTc(irow, 1) <> "" And arrReqTc(irow, 2) <> "" Then
                            xmlStr = strTemp & "        <requirements>"
                            Print #2, xmlStr
                            xmlStr = strTemp & "            <requirement>"
                            Print #2, xmlStr
                            xmlStr = strTemp & "                <req_spec_title>" & arrReqTc(irow, 1) & "</req_spec_title>"
                            Print #2, xmlStr
                            xmlStr = strTemp & "                <doc_id>" & arrReqTc(irow, 2) & "</doc_id>"
                            Print #2, xmlStr
                            xmlStr = strTemp & "            </requirement>"
                            Print #2, xmlStr
                            xmlStr = strTemp & "        </requirements>"
                            Print #2, xmlStr
                        End If
                 '   End If
                'Next i
               End If
            End If
           Case "Steps"
            If arrTc(irow, iCol - 1) <> "" Then
            xmlStr = strTemp & "        <steps>"
            Print #2, xmlStr
            End If
            xmlStr = strTemp & "        <step>"
            Print #2, xmlStr
            xmlStr = strTemp & "            <step_number><![CDATA[" & tempStep & "]]></step_number>"
            Print #2, xmlStr
            xmlStr = strTemp & "            <actions><![CDATA[" & arrTc(irow, iCol) & "]]></actions>"
            Print #2, xmlStr
          Case "Expected Results"
            xmlStr = strTemp & "            <expectedresults><![CDATA[" & arrTc(irow, iCol) & "]]></expectedresults>"
            Print #2, xmlStr
          Case "StepExecutionType"
            xmlStr = strTemp & "            <execution_type><![CDATA[" & arrTc(irow, iCol) & "]]></execution_type>"
            Print #2, xmlStr
            xmlStr = strTemp & "        </step>"
            Print #2, xmlStr
            tempStep = tempStep + 1
            If irow < arrRow Then
             If arrTc(irow + 1, iCol - 3) <> "" Then
              xmlStr = strTemp & "        </steps>"
              Print #2, xmlStr
              tempStep = 1
             End If
            Else
             xmlStr = strTemp & "        </steps>"
             Print #2, xmlStr
             tempStep = 1
            End If
          End Select
        End If
    Next iCol
     If irow < arrRow Then
         If arrTc(irow + 1, 1) <> "" Then
           xmlStr = strTemp & "    </testcase>"
           Print #2, xmlStr
         End If
     Else
           xmlStr = strTemp & "    </testcase>"
           Print #2, xmlStr
      End If
    If tsColCount <> 0 Then
      If irow < arrRow Then
        If arrTS(irow + 1, 1) <> "" Then
            Print #2, "    </testsuite>"
        End If
      Else
        Print #2, "    </testsuite>"
      End If
    End If
  Next irow
   
  If tsColCount <> 0 Then
    Print #2, "</testsuite>"
  Else
    Print #2, "</testcases>"
  End If
  Close #2
End If
End Sub
Function lastRow() As Long
  If WorksheetFunction.CountA(Cells) > 0 Then
    'Search for any entry, by searching backwards by Rows.
    lastRow = Cells.Find(What:="*", After:=[A1], _
                         SearchOrder:=xlByRows, _
                         SearchDirection:=xlPrevious).Row
  End If
End Function

Function lastColumn() As Long
   
  If WorksheetFunction.CountA(Cells) > 0 Then
 
    'Search for any entry, by searching backwards by Columns.
    lastColumn = Cells.Find(What:="*", After:=[A1], _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious).Column
  End If
End Function