[Solved] Excel data to word by VBA with tables

[Vignesh]

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.

 

[Lutfor Rahman Shimanto]

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.

​

Follow these steps:

1. Press Alt+F11.
2. Insert the following code into the module and run it.
   

   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

 

[Vignesh]

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.

View attachment 1284​

Follow these steps:

1. Press Alt+F11.
2. Insert the following code into the module and run it.
   

   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:

View attachment 1285​

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 1

Open the GC Broswer

GC Broswer should be opened

Step 2

Enter the Hotel URL and click Search

Hotel sign in page should be launched

Step 3

Enter the valid user name password

Entered valid user name and password

Step 4

Click Sign Button

Hotel page should be launched.

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

 

[Lutfor Rahman Shimanto]

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 1

Open the GC Broswer

GC Broswer should be opened

Step 2

Enter the Hotel URL and click Search

Hotel sign in page should be launched

Step 3

Enter the valid user name password

Entered valid user name and password

Step 4

Click Sign Button

Hotel 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:

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]:



OUTPUT Overview [Folder]:



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