Tom,

I ended up changing the sName callout from
sName = Cells(2, 1).Value
to
sName = Cells(2, ActiveCell.Column).Value

Then everything worked fine so long as no spaces existed in the column
header, lastly I modified the dynamic formula a little, see code below.

Many thanks for hepling me out on this one, it will save a great deal
of time.

Regards
Burl

Dim s1 As String
Dim s2 As String
Dim sName As String
s1 = ActiveSheet.Name
s2 = "'" & s1 & "'"

sName = Cells(2, ActiveCell.Column).Value
ThisWorkbook.Names.Add Name:=sName & "_" & s1, _
RefersTo:="=OFFSET(" & s2 & "!" & Cells(2, _
ActiveCell.Column).Address & _
",1,0,COUNT(" & s2 & "!" & _
ActiveCell.EntireColumn.Address & "),1)"


Debug.Print sName & "_" & s1, ThisWorkbook.Names( _
sName & "_" & s1).RefersTo