Ttykuu

So below 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 specifiying 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 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

Dim data() As String
Dim y As Variant
Dim j As Integer

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

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

i = 0
For Each z 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 z


End Sub