Private Sub but_Unsatisfactory_Click()
Dim objWord As Word.Application
Dim doc As Word.Document
Dim WordHeaderFooter As HeaderFooter
Dim QueryA As DAO.Recordset
Dim QueryB As DAO.Recordset
Dim dbs As DAO.Database
Dim strSQLA As String
Dim strSQLB As String
Dim myrange As Range
Dim DA As String
Dim DAX As String
Dim Variable As String

If Forms!frm_Assess!lst_Referrals.Column(5) <> "" Then

Set dbs = CurrentDb
DA = Forms!frm_Assess!txt_DA
DAX = """" & DA & """"

'Query SQL String for Checks
strSQLA = "SELECT tbl_DA.DAID, tbl_DA.[DA No], tbl_DAConCheck.CheckTitle, tbl_DAConCheck.CheckOutcome, tbl_DAConCheck.CheckComments, tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order " & _
"FROM tbl_DA INNER JOIN tbl_DAConCheck ON tbl_DA.DAID = tbl_DAConCheck.DAID " & _
"WHERE (((tbl_DA.[DA No])=" & DAX & ") AND ((tbl_DAConCheck.CheckOutcome)<> ""Invisible"")) " & _
"ORDER BY tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order;"
'Query SQL String for RAI
strSQLB = "SELECT tbl_DA.DAID, tbl_DA.[DA No], tbl_DAConCheck.RAIOutcome, tbl_DAConCheck.RAITitle, tbl_DAConCheck.RequestAdditionalInformation, tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order " & _
"FROM tbl_DA INNER JOIN tbl_DAConCheck ON tbl_DA.DAID = tbl_DAConCheck.DAID " & _
"WHERE (((tbl_DA.[DA No]) = " & DAX & ") And ((tbl_DAConCheck.RAIOutcome) = True)) " & _
"ORDER BY tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order;"
'Set Recordsets
Set QueryA = dbs.OpenRecordset(strSQLA)
Set QueryB = dbs.OpenRecordset(strSQLB)
 'Open Word
  Set objWord = CreateObject("Word.Application")
  With objWord
    .Visible = True
    .ScreenUpdating = False
    Set doc = .Documents.Add
    With doc
 
      'Basic Document Format
      With .Styles(wdStyleNormal)
        .Font.Name = "Arial"
        .Font.Size = 11
        With .ParagraphFormat
          .LineSpacingRule = wdLineSpaceSingle
          .SpaceAfter = 0
          .SpaceBefore = 0
        End With
      End With
'Title/IntroPage
 'Insert Gray Table
 .Tables.Add Range:=.Range.Characters.Last, NumRows:=1, NumColumns:=1, _
        DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed
      With .Tables(1)
        .Style = "Table Grid"
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
        .ApplyStyleRowBands = True
        .ApplyStyleColumnBands = False
        With .Cell(1, 1).Range
          .Shading.BackgroundPatternColor = -603937025
          .InsertAfter "Council Report Summary" & vbCr & _
            "The proposed development application does not comply with the requirements of Council's relevant policies."
          .Paragraphs.First.Range.Style = wdStyleStrong
        End With
      End With
      With .Range
        .InsertAfter vbCr & vbCr & QueryA!ConditionCategory & vbCr & vbCr
        With .Paragraphs.Last.Previous.Previous
          .Range.Style = wdStyleStrong
          .Alignment = wdAlignParagraphCenter
        End With
      End With
 
'Checks Loop Start
Variable = QueryA!ConditionCategory
Do While Not QueryA.EOF
'Check if Check Category is the same as previous if not type new category
If Variable = QueryA!ConditionCategory Then
Else
With .Range
.InsertAfter QueryA!ConditionCategory & vbCr
End With
End If
'Make sure check has a title and insert table fill in with notes
If IsNull(QueryA!CheckTitle) = True Then
Else
.Tables.Add Range:=.Range.Characters.Last, NumRows:=1, NumColumns:=2, _
        DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed
      With .Tables(2)
        .Style = "Table Grid"
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
        .ApplyStyleRowBands = True
        .ApplyStyleColumnBands = False
        
With .Cell(1, 1).Range
If IsNull(QueryA!CheckTitle) = True Then
Else
.InsertAfter QueryA!CheckTitle
End If
End With
With .Cell(1, 2).Range
If IsNull(QueryA!CheckOutcome) = True Then
Else
.InsertAfter QueryA!CheckOutcome & vbCr
End If
If IsNull(QueryA!CheckComments) = True Then
Else
.InsertAfter QueryA!CheckComments
End If
'End with for Cell
End With
'End with for Tables
End With
      With .Range
.InsertAfter vbCr & vbCr
       With .Paragraphs.Last.Previous.Previous
          .Range.Style = wdStyleStrong
          .Alignment = wdAlignParagraphLeft
        End With
'End with for Paragraph
      End With
'End If for Check that there is data for CheckTitle
End If
Variable = QueryA!ConditionCategory
    QueryA.MoveNext
    Loop
            
    QueryA.Close
    'Checks Loop Ends
 
'End With 'Not sure if this should be here
.SaveAs CurrentProject.Path & "\TestDoc.doc"
 
'end with doc
End With
    .ScreenUpdating = True
'end with objword
  End With

Set objWord = Nothing
Else
MsgBox "Referal Completed Date Required", 0, "Date Required"
End If
End Sub