View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default 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