Export Excel to Word, make specific words/headlines BOLD

[perola.rike]

I have a spreadsheet that creates a textreport stored in MS Word based on calculations and VBA code in Excel. I want to export the text to word, which the code below does perfectly, but I also want specific words in this text to be formatted bold. It is mainly mainly headlines such as "Neuropsychological results:", "Conclusion", "Objective"

Any idea how to write a code that format specific words bold?

Any contributions or modifications of the code below (or a completely new one) are appreciated!

The word export code:

Sub wordgenerator()



' Creates Word document of Auction Items using Automation



Dim WordApp As Object
Dim LastRow As Integer, i As Integer, r As Integer, Records As Integer

On Error Resume Next
Application.ScreenUpdating = False

' Start Word And create an Object
Set WordApp = CreateObject("Word.Application")
With WordApp
.Documents.Add
End With


WSName = "Oppstart"
change "Sheet1" to sheet tab name containing cell reference
CName = "Navn"
change "A1" to the cell with your date
savename = Sheets(WSName).Range(CName).Text
SaveAsName = ThisWorkbook.Path & "\" & "Autorapport " & savename & ".doc"



LastRow = Selection.SpecialCells(xlCellTypeLastCell).Rows.Row
Application.StatusBar = "Deleting Empty Rows from " & LastRow & " Used Rows"
' Cycle through all records In Items
On Error Resume Next
For r = LastRow To 1 Step -1
If Application.WorksheetFunction.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r

'Delete error cells like DIV/0!, N/A
On Error Resume Next
Columns("A:A").SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete

' Update Last Row value In Case rows were deleted
Sheets("wordgenerator").Range("A1:A200").FormatConditions.Delete
Records = ActiveSheet.UsedRange.Rows.Count


' Information from worksheet
Set Data = Sheets("wordgenerator").Range("A1")

' Cycle through all records In Items

For i = 2 To Records
' Update status bar progress message
Application.StatusBar = "Processing Record " & i & " of " & Records

' Assign current data To variables
Letter = Data.Offset(i - 1, 0).Value
Number = Data.Offset(i - 1, 1).Value
Title = Data.Offset(i - 1, 2).Value
Descript = Data.Offset(i - 1, 3).Value
FMV = Format(Data.Offset(i - 1, 4).Value, "#,000")
FMText = Data.Offset(i - 1, 5).Value
Donor = Data.Offset(i - 1, 6).Value

' Send commands To Word
With WordApp
With .Selection
.TypeParagraph
.Font.Name = "Calibri"
.Font.Size = 11
.Font.Bold = False
.ParagraphFormat.Alignment = 0
.TypeText Text:=Letter & Number & " "
.Font.Underline = True
.Font.Allcaps = True
.TypeText Text:=Title
.Font.Allcaps = False
.Font.Bold = False
.Font.Underline = False

End With
End With
Next i

' Save the Word file And Close it
With WordApp
.ActiveDocument.SaveAs Filename:=SaveAsName
.ActiveWindow.Close
' Kill the Object
.Quit
End With

Set WordApp = Nothing

' Reset status bar
Application.StatusBar = ""
MsgBox "Autoreport " & savename & ".doc was saved in " & ThisWorkbook.Path


End Sub