Ttykuu

Here is my code for a sub which does the following:

1. read header of a table into an array




2. reads first row of said table into a 2nd array




3. loops through the first array and replaces the marked keywords <keyword> in a word template file (.dotx) with the data row cell (includes header and body)

This sub is then called by another sub specifying both table rows and the template file.

Now since I am not a programmer by profession I am pretty sure that this is far from the best way to do it efficiently, so any comments or improvements are much appreciated.

Sub ReplacefromRange(header As Range, DataRow As Range, TemplateFile)

 Dim heading() As String
 Dim data() As String
 Dim i As Integer
 Dim x As Variant

 ' Creates a first array that takes "header" as argument
 i = -1
 For Each x In header.Cells
 i = i + 1
 ReDim Preserve heading(i) As String
 heading(i) = x.Value
 Next x

 ' Creates second array that takes "DataRow" as argument
 i = -1
 For Each x In DataRow.Cells
 i = i + 1
 ReDim Preserve data(i) As String
 data(i) = x.Value
 Next x

 ' Uses a for each loop through heading() to find and replace individual entries in the "TemplateFile" argument

 i = 0
 For Each x In heading()
 With TemplateFile 'looks at the word document body
 .Application.Selection.Find.Text = "<" & heading(i) & ">"
 .Application.Selection.Find.Execute
 .Application.Selection = data(i)
 .Application.Selection.EndOf
 ' the part below looks at the header content
 .Sections(1).headers(wdHeaderFooterPrimary).Range.Find.Execute _
 FindText:="<" & heading(i) & ">", Format:=False, ReplaceWith:=data(i), Replace:=wdReplaceAll, Wrap:=wdFindContinue
 i = i + 1
 End With
 Next x


End Sub