Define Names in Workbook through Code
Option Explicit
Sub testme()
Dim myRng As Range
Dim myTitles As Variant
Dim myNames As Variant
Dim iCtr As Long
Dim FoundCell As Range
Dim FirstAddress As String
myNames = Array("Name01", "Name02", "Name03", "Name04", "Name05")
myTitles = Array("a", "what you want1", "another one", _
"next one", "last one here")
If UBound(myNames) < UBound(myTitles) Then
MsgBox "design error!"
Exit Sub
End If
With ActiveSheet
For iCtr = LBound(myTitles) To UBound(myTitles)
FirstAddress = ""
Set myRng = Nothing
With .Rows(1) 'row with header
Set FoundCell = .Cells.Find(what:=myTitles(iCtr), _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByColumns, _
searchdirection:=xlNext, _
MatchCase:=False)
If FoundCell Is Nothing Then
MsgBox myTitles(iCtr) & " wasn't found!"
Else
FirstAddress = FoundCell.Address
Set myRng = FoundCell
Do
Set FoundCell = .FindNext(after:=FoundCell)
If FoundCell.Address = FirstAddress Then
Exit Do
End If
Set myRng = Union(myRng, FoundCell)
Loop
myRng.EntireColumn.Name = myNames(iCtr)
End If
End With
Next iCtr
End With
End Sub
Arnold wrote:
Hi Dave,
Thanks for the reply and code. The columns will, however, not be laid
out so nicely--that is, they will not go in any particular order
horizontally across the sheet. Also, there will be more of some
columns than others. Will the code account for this? I'll try it as
soon as I can.
Thanks.
--
Dave Peterson
|