Hi Mark

Try this adaption:

Sub header()
Dim eCol As Integer
Dim i As Integer
Dim head As String
Dim hdArr As Variant
Dim j As Integer
Dim hdLen As Integer
Dim tLen As Integer

eCol = Cells(1, Columns.Count).End(xlToLeft).Column
Rows(1).WrapText = False
For i = 1 To eCol
With Cells(1, i)
head = .Value
hdArr = Split(head, " ")
For j = 0 To UBound(hdArr)
tLen = Len(hdArr(j))
If tLen hdLen Then
hdLen = tLen
End If
Next j
.Value = String(hdLen, "X")
.EntireColumn.AutoFit
.WrapText = True
.Value = head
hdLen = 0
End With
Erase hdArr
Next i
End Sub

Regards
Rowan

MarkN wrote:
Hello Rowan

Thank you for your reply Rowan, this comes close but I have now identified
another problem! Is there something that I can do so when the column headers
wrap to the autofit, the wrapping only occurs at breaks between words (not
anywhere within the word as I now have column headers that are difficult to
read where the width of the data in the column is only two or three
characters).