[Solved] Excel data to word by VBA with tables

Vignesh

New member
There are several test cases on an Excel file I have. Since every test has different stages, I want to make a Word document for each test case and print the step with space in word. I want one table column with a heading above these steps. The left side of the page should have the headline, and the right side should be empty. The sample Excel sheet image and word file table is attached here. Anyone please gives the solution for the same. Thanks in Advance.
 

Attachments

  • sample TC excel.xlsm
    34.4 KB · Views: 6
  • sample word format for tc.png
    sample word format for tc.png
    33.3 KB · Views: 4
Last edited:
There are several test cases on an Excel file I have. Since every test has different stages, I want to make a Word document for each test case and print the step with space in word. I want one table column with a heading above these steps. The left side of the page should have the headline, and the right side should be empty. The sample Excel sheet image and word file table is attached here. Anyone please gives the solution for the same. Thanks in Advance.
Hello Vignesh

Thanks for reaching out and sharing your query with such clarity. I am delighted to inform you that I have developed an Excel VBA Sub-procedure to fulfil your goal.

Assuming your data structure is like the following GIF.

Dataset.gif

Follow these steps:
  1. Press Alt+F11.
  2. Insert the following code into the module and run it.
    Code:
    Sub ReportInWord()
    
        Dim ws As Worksheet
        Dim lastRow As Long
        Dim uniqueValues As New Collection
        Dim cell As Range
        Dim value As Variant
       
        Dim wdApp As Object
        Dim wdDoc As Object
        Dim tblInfo As Object
        Dim tblSteps As Object
       
        Set ws = ThisWorkbook.Sheets("E2E")
       
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
       
        For Each cell In ws.Range("A2:A" & lastRow)
            On Error Resume Next
            uniqueValues.Add cell.value, CStr(cell.value)
            On Error GoTo 0
        Next cell
       
        cellLoopTracker = 0
       
        For Each value In uniqueValues
           
                Set wdApp = CreateObject("Word.Application")
                wdApp.Visible = True
               
                Set wdDoc = wdApp.Documents.Add
       
                With wdDoc
                    Dim rngInfo As Object
                    Set rngInfo = .Range
                   
                    Set tblInfo = .Tables.Add(rngInfo, 7, 2)
                    tblInfo.Borders.Enable = True
                   
                    tblInfo.cell(1, 1).Range.Text = ws.Range("A1").value
                    tblInfo.cell(1, 2).Range.Text = value
                   
                    tblInfo.cell(2, 1).Range.Text = ws.Range("B1").value
                    tblInfo.cell(3, 1).Range.Text = ws.Range("C1").value
                    tblInfo.cell(4, 1).Range.Text = ws.Range("D1").value
                    tblInfo.cell(5, 1).Range.Text = ws.Range("I1").value
                    tblInfo.cell(6, 1).Range.Text = ws.Range("N1").value
                    tblInfo.cell(7, 1).Range.Text = ws.Range("O1").value
                   
                    For cellLoop = 2 To lastRow
                        If ws.Range("A" & cellLoop).value = value Then
                            tblInfo.cell(2, 2).Range.Text = ws.Range("B" & cellLoop).value
                            tblInfo.cell(3, 2).Range.Text = ws.Range("C" & cellLoop).value
                            tblInfo.cell(4, 2).Range.Text = ws.Range("D" & cellLoop).value
                            tblInfo.cell(5, 2).Range.Text = ws.Range("I" & cellLoop).value
                            tblInfo.cell(6, 2).Range.Text = ws.Range("N" & cellLoop).value
                            tblInfo.cell(7, 2).Range.Text = ws.Range("O" & cellLoop).value
                            Exit For
                        End If
                    Next cellLoop
                   
                    .Content.InsertParagraphAfter
               
                End With
               
                With wdDoc
           
                    Dim rngSteps As Object
                    Set rngSteps = .Range
                   
                    rngSteps.Collapse 0
                    rngSteps.InsertParagraphAfter
                   
                    Set tblSteps = .Tables.Add(rngSteps, 7, 3)
                    tblSteps.Borders.Enable = True
                   
                    tblSteps.cell(1, 1).Range.Text = "Step No."
                    tblSteps.cell(1, 2).Range.Text = "Test Step Description"
                    tblSteps.cell(1, 3).Range.Text = "Expected Result"
                   
                    previousCellLoop = 1
                   
                    For cellLoop = 2 To lastRow
                                           
                        If ws.Range("A" & cellLoop).value = value Then
                                tblSteps.cell(cellLoop - previousCellLoop + 1, 1).Range.Text = ws.Range("J" & cellLoop).value
                                tblSteps.cell(cellLoop - previousCellLoop + 1, 2).Range.Text = ws.Range("K" & cellLoop).value
                                tblSteps.cell(cellLoop - previousCellLoop + 1, 3).Range.Text = ws.Range("L" & cellLoop).value
                        Else
                            previousCellLoop = cellLoop
                        End If
                       
                    Next cellLoop
                   
                   
                End With
               
                Set tblInfo = Nothing
                Set tblSteps = Nothing
                Set wdDoc = Nothing
                Set wdApp = Nothing
           
        Next value
    
    End Sub
As a result, you will see the intended result, such as the following:

Output of running Excel VBA code.png

Hopefully, the code will fulfil your goal; good luck.

Regards
Lutfor Rahman Shimanto
Excel & VBA Developer
ExcelDemy
 
Hello Vignesh

Thanks for reaching out and sharing your query with such clarity. I am delighted to inform you that I have developed an Excel VBA Sub-procedure to fulfil your goal.

Assuming your data structure is like the following GIF.


Follow these steps:
  1. Press Alt+F11.
  2. Insert the following code into the module and run it.
    Code:
    Sub ReportInWord()
    
        Dim ws As Worksheet
        Dim lastRow As Long
        Dim uniqueValues As New Collection
        Dim cell As Range
        Dim value As Variant
      
        Dim wdApp As Object
        Dim wdDoc As Object
        Dim tblInfo As Object
        Dim tblSteps As Object
      
        Set ws = ThisWorkbook.Sheets("E2E")
      
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
      
        For Each cell In ws.Range("A2:A" & lastRow)
            On Error Resume Next
            uniqueValues.Add cell.value, CStr(cell.value)
            On Error GoTo 0
        Next cell
      
        cellLoopTracker = 0
      
        For Each value In uniqueValues
          
                Set wdApp = CreateObject("Word.Application")
                wdApp.Visible = True
              
                Set wdDoc = wdApp.Documents.Add
      
                With wdDoc
                    Dim rngInfo As Object
                    Set rngInfo = .Range
                  
                    Set tblInfo = .Tables.Add(rngInfo, 7, 2)
                    tblInfo.Borders.Enable = True
                  
                    tblInfo.cell(1, 1).Range.Text = ws.Range("A1").value
                    tblInfo.cell(1, 2).Range.Text = value
                  
                    tblInfo.cell(2, 1).Range.Text = ws.Range("B1").value
                    tblInfo.cell(3, 1).Range.Text = ws.Range("C1").value
                    tblInfo.cell(4, 1).Range.Text = ws.Range("D1").value
                    tblInfo.cell(5, 1).Range.Text = ws.Range("I1").value
                    tblInfo.cell(6, 1).Range.Text = ws.Range("N1").value
                    tblInfo.cell(7, 1).Range.Text = ws.Range("O1").value
                  
                    For cellLoop = 2 To lastRow
                        If ws.Range("A" & cellLoop).value = value Then
                            tblInfo.cell(2, 2).Range.Text = ws.Range("B" & cellLoop).value
                            tblInfo.cell(3, 2).Range.Text = ws.Range("C" & cellLoop).value
                            tblInfo.cell(4, 2).Range.Text = ws.Range("D" & cellLoop).value
                            tblInfo.cell(5, 2).Range.Text = ws.Range("I" & cellLoop).value
                            tblInfo.cell(6, 2).Range.Text = ws.Range("N" & cellLoop).value
                            tblInfo.cell(7, 2).Range.Text = ws.Range("O" & cellLoop).value
                            Exit For
                        End If
                    Next cellLoop
                  
                    .Content.InsertParagraphAfter
              
                End With
              
                With wdDoc
          
                    Dim rngSteps As Object
                    Set rngSteps = .Range
                  
                    rngSteps.Collapse 0
                    rngSteps.InsertParagraphAfter
                  
                    Set tblSteps = .Tables.Add(rngSteps, 7, 3)
                    tblSteps.Borders.Enable = True
                  
                    tblSteps.cell(1, 1).Range.Text = "Step No."
                    tblSteps.cell(1, 2).Range.Text = "Test Step Description"
                    tblSteps.cell(1, 3).Range.Text = "Expected Result"
                  
                    previousCellLoop = 1
                  
                    For cellLoop = 2 To lastRow
                                          
                        If ws.Range("A" & cellLoop).value = value Then
                                tblSteps.cell(cellLoop - previousCellLoop + 1, 1).Range.Text = ws.Range("J" & cellLoop).value
                                tblSteps.cell(cellLoop - previousCellLoop + 1, 2).Range.Text = ws.Range("K" & cellLoop).value
                                tblSteps.cell(cellLoop - previousCellLoop + 1, 3).Range.Text = ws.Range("L" & cellLoop).value
                        Else
                            previousCellLoop = cellLoop
                        End If
                      
                    Next cellLoop
                  
                  
                End With
              
                Set tblInfo = Nothing
                Set tblSteps = Nothing
                Set wdDoc = Nothing
                Set wdApp = Nothing
          
        Next value
    
    End Sub
As a result, you will see the intended result, such as the following:


Hopefully, the code will fulfil your goal; good luck.

Regards
Lutfor Rahman Shimanto
Excel & VBA Developer
ExcelDemy
Thanks for your help; it fulfilled my goal. One more small help: I want to save this document in a particular folder with the test case name or number, i.e., TC-1, and I want each step to have a space.
Example :

Step 1Open the GC BroswerGC Broswer should be opened

Step 2Enter the Hotel URL and click SearchHotel sign in page should be launched

Step 3Enter the valid user name passwordEntered valid user name and password

Step 4Click Sign ButtonHotel page should be launched.

I want above format could you please help for the same.
 
Thanks for your help; it fulfilled my goal. One more small help: I want to save this document in a particular folder with the test case name or number, i.e., TC-1, and I want each step to have a space.
Example :

Step 1Open the GC BroswerGC Broswer should be opened

Step 2Enter the Hotel URL and click SearchHotel sign in page should be launched

Step 3Enter the valid user name passwordEntered valid user name and password

Step 4Click Sign ButtonHotel page should be launched.

I want above format could you please help for the same.
Dear Vignesh

Thanks for your kind words. I am delighted to hear that the code fulfilled your goal. You want to save the generated documents in a particular folder with the test case name or number, e.g., TC-1, and each step should have a space.

I have developed another Excel VBA Sub-procedure per your request to meet your expected result. After running the code, it will take a few seconds to create a folder in the same destination as the Excel file. Later, it will save the generated documents in the folder with the test case name or number, e.g., TC-1, and add a space between each step.

Excel VBA Code:
Code:
Sub ReportInWord()

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim uniqueValues As New Collection
    Dim cell As Range
    Dim value As Variant
    
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim tblInfo As Object
    Dim tblSteps As Object
    
    Dim savePath As String
    Dim folderPath As String
    
    folderPath = ThisWorkbook.Path & "\Test Cases\"
    
    If Dir(folderPath, vbDirectory) = "" Then
        MkDir folderPath
    End If
    
    Set ws = ThisWorkbook.Sheets("E2E")
    
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    For Each cell In ws.Range("A2:A" & lastRow)
        On Error Resume Next
        uniqueValues.Add cell.value, CStr(cell.value)
        On Error GoTo 0
    Next cell
    
    cellLoopTracker = 0
    
    For Each value In uniqueValues
        
            Set wdApp = CreateObject("Word.Application")
            wdApp.Visible = True
            
            Set wdDoc = wdApp.Documents.Add
    
            With wdDoc
                Dim rngInfo As Object
                Set rngInfo = .Range
                
                Set tblInfo = .Tables.Add(rngInfo, 7, 2)
                tblInfo.Borders.Enable = True
                
                tblInfo.cell(1, 1).Range.Text = ws.Range("A1").value
                tblInfo.cell(1, 2).Range.Text = value
                
                tblInfo.cell(2, 1).Range.Text = ws.Range("B1").value
                tblInfo.cell(3, 1).Range.Text = ws.Range("C1").value
                tblInfo.cell(4, 1).Range.Text = ws.Range("D1").value
                tblInfo.cell(5, 1).Range.Text = ws.Range("I1").value
                tblInfo.cell(6, 1).Range.Text = ws.Range("N1").value
                tblInfo.cell(7, 1).Range.Text = ws.Range("O1").value
                
                For cellLoop = 2 To lastRow
                    If ws.Range("A" & cellLoop).value = value Then
                        tblInfo.cell(2, 2).Range.Text = ws.Range("B" & cellLoop).value
                        tblInfo.cell(3, 2).Range.Text = ws.Range("C" & cellLoop).value
                        tblInfo.cell(4, 2).Range.Text = ws.Range("D" & cellLoop).value
                        tblInfo.cell(5, 2).Range.Text = ws.Range("I" & cellLoop).value
                        tblInfo.cell(6, 2).Range.Text = ws.Range("N" & cellLoop).value
                        tblInfo.cell(7, 2).Range.Text = ws.Range("O" & cellLoop).value
                        Exit For
                    End If
                Next cellLoop
                
                .Content.InsertParagraphAfter
            
            End With
            
            With wdDoc
                        
                previousCellLoop = 1
                
                For cellLoop = 2 To lastRow
                                        
                    If ws.Range("A" & cellLoop).value = value Then
                        
                        Dim rngStepsTemp As Object
                        Set rngStepsTemp = .Range
                        
                        rngStepsTemp.Collapse 0
                        rngStepsTemp.InsertParagraphAfter
                        
                        Dim tblStepsTemp As Object
                        
                        Set tblStepsTemp = .Tables.Add(rngStepsTemp, 1, 3)
                        tblStepsTemp.Borders.Enable = True
                        
                        tblStepsTemp.cell(1, 1).Range.Text = ws.Range("J" & cellLoop).value
                        tblStepsTemp.cell(1, 2).Range.Text = ws.Range("K" & cellLoop).value
                        tblStepsTemp.cell(1, 3).Range.Text = ws.Range("L" & cellLoop).value
                        
                        Set tb1StepsTemp = Nothing
                        Set rngStepsTemp = Nothing
                        
                        .Content.InsertParagraphAfter
                        
                    Else
                        previousCellLoop = cellLoop
                    End If
                    
                Next cellLoop
                
            End With
            
            savePath = folderPath & value & ".docx"
            wdDoc.SaveAs2 savePath
            
            wdApp.Quit
            
            Set tblInfo = Nothing
            Set tblSteps = Nothing
            Set wdDoc = Nothing
            Set wdApp = Nothing
        
    Next value

End Sub

OUTPUT Overview [Files]:

1710238274262.png

OUTPUT Overview [Folder]:

1710238360594.png

I am also attaching the solution workbook for better understanding. I hope you have found the Sub-procedure helpful; stay blessed.

Regards
Lutfor Rahman Shimanto
Excel & VBA Developer
ExcelDemy
 

Attachments

  • Vignesh (SOLVED).xlsm
    35.2 KB · Views: 2

Online statistics

Members online
0
Guests online
56
Total visitors
56

Forum statistics

Threads
337
Messages
1,470
Members
624
Latest member
duytoi
Top