Option Explicit

Private Const sWB As String = "C:\Path\excelsample.xlsx" 'Your workbook
Private Const sSheet As String = "Sheet1"
Private Const sTemplate As String = "C:\Path\SampleWordDoc.docx" ' your example document

Sub CreateDoc()
Dim oDoc As Document
Dim oRng As Range
Dim Arr() As Variant
Dim i As Long
Dim sStatus As String
Dim sID As String
Dim sTitle As String
Dim sUrl As String
Dim sOrg As String
Dim sStart As String
Dim sEnd As String
Dim sTeam As String
Dim sCategory As String
Dim sNote As String

    Set oDoc = Documents.Add(sTemplate)
    Set oRng = oDoc.Range
    oRng.MoveStart wdParagraph
    oRng.Text = ""
    
    Arr = xlFillArray(sWB, sSheet)
    For i = 0 To UBound(Arr, 2)        ' Second array dimension is columns.
        sStatus = Arr(0, i)
        sID = Arr(1, i)
        sTitle = Arr(2, i)
        sUrl = Arr(3, i)
        sOrg = Arr(4, i)
        sStart = Arr(5, i)
        sEnd = Arr(6, i)
        sTeam = Arr(7, i)
        sCategory = Right(Arr(8, i), 1)
        sNote = Arr(9, i)
        If Not LCase(sStatus) = "include" Then GoTo Skip
        oRng.Text = "Category " & sCategory & vbCr
        oRng.Style = "Heading 2"
        oRng.Collapse 0
        oRng.Text = sTitle & vbCr
        oRng.Style = "Heading 3"
        oRng.Collapse 0
        oRng.Text = "URL: " & sUrl & vbCr
        oRng.Style = "List Paragraph"
        oRng.Collapse 0
        oRng.Text = "Organization: " & sOrg & vbCr
        oRng.Style = "List Paragraph"
        oRng.Collapse 0
        oRng.Text = "Project Age: " & Date - CDate(sStart) & " days" & vbCr
        oRng.Style = "List Paragraph"
        oRng.Collapse 0
        oRng.Text = "Est. Completion Date: " & sEnd & vbCr
        oRng.Style = "List Paragraph"
        oRng.Collapse 0
        oRng.Text = "Team: " & sTeam & vbCr
        oRng.Style = "List Paragraph"
        oRng.Collapse 0
        oRng.Text = "Notes: " & sNote & vbCr
        oRng.Style = "List Paragraph"
        oRng.Collapse 0
Skip:
    Next i
lbl_Exit:
    Exit Sub
End Sub

Private Function xlFillArray(strWorkbook As String, _
                             strRange As String) As Variant
'Graham Mayor - http://www.gmayor.com - 24/09/2016
Dim RS As Object
Dim CN As Object
Dim iRows As Long

strRange = strRange & "$]"    'Use this to work with a named worksheet
    'strRange = strRange & "]" 'Use this to work with a named range
    Set CN = CreateObject("ADODB.Connection")

    'Set HDR=NO for no header row
    CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                              "Data Source=" & strWorkbook & ";" & _
                              "Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"""

    Set RS = CreateObject("ADODB.Recordset")
    RS.Open "SELECT * FROM [" & strRange, CN, 2, 1

    With RS
        .MoveLast
        iRows = .RecordCount
        .MoveFirst
    End With
    xlFillArray = RS.GetRows(iRows)
    If RS.State = 1 Then RS.Close
    Set RS = Nothing
    If CN.State = 1 Then CN.Close
    Set CN = Nothing
lbl_Exit:
    Exit Function
End Function