Hello All,
I am using Excel 2007 and have a following problem. I have several
hundred cols of Data with variable entries.

for eg

City Town State ... ...... ...... ...... ....
Dubai Karama UAE
Sharjah Rolla
Ajman



The macro when run should create range name for all active area in the
sheet (until the last col) using the Header Row (eg. City, Town,
State, ...., ......., ......., .........).

The following code downloaded from www.contextures.com creates range
name but it includes the blank also.
As my data is of variable range I need the Named Ranges till the last
entry in the column only (eg City should have Dubai, Sharjah, Ajman &
Town should have Karama, Rolla, State should be UAE only .......and so
on)


Sub CreateNames()
'http://www.contextures.com/xlNames03.html

' written by Roger Govier, Technology4U
Dim wb As Workbook, ws As Worksheet
Dim lrow As Long, lcol As Long, i As Long
Dim myName As String, Start As String

' set the row number where headings are held as a constant
' change this to the row number required if not row 1
Const Rowno = 1

' set the Offset as the number of rows below Rowno, where the
' data begins
Const Offset = 1

' set the starting column for the data, in this case 1
' change if the data does not start in column A
Const Colno = 1


On Error GoTo CreateNames_Error

Set wb = ActiveWorkbook
Set ws = ActiveSheet

' count the number of columns used in the row designated to
' have the header names

lcol = ws.Cells(Rowno, 1).End(xlToRight).Column
lrow = ws.Cells(Rows.Count, Colno).End(xlUp).Row
Start = Cells(Rowno, Colno).Address

wb.Names.Add Name:="lcol", _
RefersTo:="=COUNTA($" & Rowno & ":$" & Rowno & ")"
wb.Names.Add Name:="lrow", _
RefersToR1C1:="=COUNTA(C" & Colno & ")"
wb.Names.Add Name:="myData", RefersTo:= _
"=" & Start & ":INDEX($1:$65536," & "lrow," &
"Lcol)"

For i = Colno To lcol
' if a column header contains spaces,
' replace the space with an underscore
' spaces are not allowed in range names.
myName = Replace(Cells(Rowno, i).Value, " ", "_")
If myName = "" Then
' if column header is blank, warn the user and
' stop the macro at that point
' names will only be created for those cells with text in
them.
MsgBox "Missing Name in column " & i & vbCrLf _
& "Please Enter a Name and run macro again"
Exit Sub
End If
wb.Names.Add Name:=myName, RefersToR1C1:= _
"=R" & Rowno + Offset & "C" & i & ":INDEX(C" & i &
",lrow)"
nexti:
Next i

On Error GoTo 0
MsgBox "All dynamic Named ranges have been created"
Exit Sub

CreateNames_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & _
") in procedure CreateNames of Module Technology4U"

End Sub

Can someone help me on this please?

Regards
Rashid Khan

Hello Rashid,

Am Wed, 15 Jun 2011 10:40:25 -0700 (PDT) schrieb prkhan56:

I am using Excel 2007 and have a following problem. I have several
hundred cols of Data with variable entries.

for eg

City Town State ... ...... ...... ...... ....
Dubai Karama UAE
Sharjah Rolla
Ajman

The macro when run should create range name for all active area in the
sheet (until the last col) using the Header Row (eg. City, Town,
State, ...., ......., ......., .........).

try:
Sub myNames()
Dim LCol As Integer
Dim LRow As Long
Dim i As Integer

With ActiveSheet
LCol = .Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To LCol
LRow = .Cells(Rows.Count, i).End(xlUp).Row
ActiveWorkbook.Names.Add Name:=.Cells(1, i), _
RefersTo:=.Range(.Cells(1, i), .Cells(LRow, i))
Next
End With
End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Jun 15, 10:02*pm, Claus Busch wrote:
Hello Rashid,

Am Wed, 15 Jun 2011 10:40:25 -0700 (PDT) schrieb prkhan56:

I am using Excel 2007 and have a following problem. *I have several
hundred cols of Data with variable entries.

for eg

City * * * Town * * * State *... * *...... * *....... * *...... * ....
Dubai * * Karama * UAE
Sharjah *Rolla
Ajman

The macro when run should createrangenamefor all active area in the
sheet (until the last col) using the Header Row (eg. City, Town,
State, ...., ......., ......., *.........).

try:
Sub myNames()
Dim LCol As Integer
Dim LRow As Long
Dim i As Integer

With ActiveSheet
* * LCol = .Cells(1, Columns.Count).End(xlToLeft).Column
* * For i = 1 To LCol
* * * * LRow = .Cells(Rows.Count, i).End(xlUp).Row
* * * * ActiveWorkbook.Names.AddName:=.Cells(1, i), _
* * * * * * RefersTo:=.Range(.Cells(1, i), .Cells(LRow, i))
* * Next
End With
End Sub

Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hello Claus
Thanks for the code.
Can we have a check (similar to the code on Contextures) given below
to look for Blanks and Col Header with spaces

' if a column header contains spaces,
' replace the space with an underscore
' spaces are not allowed in range names.
myName = Replace(Cells(Rowno, i).Value, " ", "_")
If myName = "" Then
' if column header is blank, warn the user and
' stop the macro at that point
' names will only be created for those cells with text in
them.

Regards
Rashid

Hi Rashid,

try:

Sub myNames()
Dim LCol As Integer
Dim LRow As Long
Dim i As Integer
Dim rngName As String

With ActiveSheet
LCol = .Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To LCol
If .Cells(1, i) = "" Then
MsgBox "Enter a header in column " & i _
& " run macro again", vbOKOnly
Exit For
End If
LRow = .Cells(Rows.Count, i).End(xlUp).Row
rngName = Replace(.Cells(1, i), " ", "_")
ActiveWorkbook.Names.Add Name:=rngName, _
RefersTo:=.Range(.Cells(1, i), .Cells(LRow, i))
Next
End With
End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Jun 16, 12:27*am, Claus Busch wrote:
Hi Rashid,

try:

Sub myNames()
Dim LCol As Integer
Dim LRow As Long
Dim i As Integer
Dim rngName As String

With ActiveSheet
* * LCol = .Cells(1, Columns.Count).End(xlToLeft).Column
* * For i = 1 To LCol
* * * * If .Cells(1, i) = "" Then
* * * * * * MsgBox "Enter a header in column " & i _
* * * * * * * * & " run macro again", vbOKOnly
* * * * * * * * Exit For
* * * * End If
* * * * LRow = .Cells(Rows.Count, i).End(xlUp).Row
* * * * rngName = Replace(.Cells(1, i), " ", "_")
* * * * ActiveWorkbook.Names.Add Name:=rngName, _
* * * * * * RefersTo:=.Range(.Cells(1, i), .Cells(LRow, i))
* * Next
End With
End Sub

Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Perfect.
You are a hero.
Thanks a lot
Rashid

Sounds to me like what you want is to make dynamic defined name ranges
so each one is sized according to its column's contents. Fairly simple
as long as the columns contain contiguous data (ie: no blanks between
data). I believe this is what Debra's CreateNames procedure does and so
begs to ask why it doesn't address your needs?

For example, taking the 3 headings you provide...

Cell A1="City", Cell B1="Town", Cell C1="State"

Define A1 as...
Name="'Sheet name'!City_Hdr",
RefersTo="=$A$1"

Define the list under "City_Hdr" as...
Name="'Sheet name'!City",
RefersTo="=OFFSET(City_Hdr,1,0,COUNTA($A:$A)-1,1)

Define A1 as...
Name="'Sheet name'!City_Hdr",
RefersTo="=$B$1"

Define the list under "Town_Hdr" as...
Name="'Sheet name'!Town",
RefersTo="=OFFSET(Town_Hdr,1,0,COUNTA($B:$B)-1,1)

Define A1 as...
Name="'Sheet name'!State_Hdr",
RefersTo="=$C$1"

Define the list under "State_Hdr" as...
Name="'Sheet name'!State",
RefersTo="=OFFSET(State_Hdr,1,0,COUNTA($C:$C)-1,1)

**Note**
I want to emphasize AGAIN that dynamic defined name ranges only work
correctly if there are no blanks between the heading and last entry
under the heading.

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Corrections:

Cell A1="City", Cell B1="Town", Cell C1="State"

Define A1 as...
Name="'Sheet name'!City_Hdr",
RefersTo="=$A$1"

Define the list under "City_Hdr" as...
Name="'Sheet name'!City",
RefersTo="=OFFSET(City_Hdr,1,0,COUNTA($A:$A)-1,1)


Define B1 as...

Name="'Sheet name'!City_Hdr",
RefersTo="=$B$1"

Define the list under "Town_Hdr" as...
Name="'Sheet name'!Town",
RefersTo="=OFFSET(Town_Hdr,1,0,COUNTA($B:$B)-1,1)


Define C1 as...

Name="'Sheet name'!State_Hdr",
RefersTo="=$C$1"

Define the list under "State_Hdr" as...
Name="'Sheet name'!State",
RefersTo="=OFFSET(State_Hdr,1,0,COUNTA($C:$C)-1,1)

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

On Jun 16, 12:01*am, GS wrote:
Corrections:

* Cell A1="City", Cell B1="Town", Cell C1="State"

* Define A1 as...
* * Name="'Sheet name'!City_Hdr",
* * RefersTo="=$A$1"

* Define the list under "City_Hdr" as...
* * Name="'Sheet name'!City",
* * RefersTo="=OFFSET(City_Hdr,1,0,COUNTA($A:$A)-1,1)

* * Define B1 as...

* * Name="'Sheet name'!City_Hdr",
* * RefersTo="=$B$1"

* Define the list under "Town_Hdr" as...
* * Name="'Sheet name'!Town",
* * RefersTo="=OFFSET(Town_Hdr,1,0,COUNTA($B:$B)-1,1)

* * Define C1 as...

* * Name="'Sheet name'!State_Hdr",
* * RefersTo="=$C$1"

* Define the list under "State_Hdr" as...
* * Name="'Sheet name'!State",
* * RefersTo="=OFFSET(State_Hdr,1,0,COUNTA($C:$C)-1,1)

--
Garry

Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Hi Gary,
Thanks for your suggestion.
Claus has provided the code

prkhan56 submitted this idea :
On Jun 16, 12:01*am, GS wrote:
Corrections:

* Cell A1="City", Cell B1="Town", Cell C1="State"
* Define A1 as...
* * Name="'Sheet name'!City_Hdr",
* * RefersTo="=$A$1"

* Define the list under "City_Hdr" as...
* * Name="'Sheet name'!City",
* * RefersTo="=OFFSET(City_Hdr,1,0,COUNTA($A:$A)-1,1)

* * Define B1 as...

* * Name="'Sheet name'!City_Hdr",
* * RefersTo="=$B$1"

* Define the list under "Town_Hdr" as...
* * Name="'Sheet name'!Town",
* * RefersTo="=OFFSET(Town_Hdr,1,0,COUNTA($B:$B)-1,1)

* * Define C1 as...

* * Name="'Sheet name'!State_Hdr",
* * RefersTo="=$C$1"

* Define the list under "State_Hdr" as...
* * Name="'Sheet name'!State",
* * RefersTo="=OFFSET(State_Hdr,1,0,COUNTA($C:$C)-1,1)

--
Garry

Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Hi Gary,
Thanks for your suggestion.
Claus has provided the code

Ok, but note that Claus's very nice code doesn't make the ranges
dynamic and so it must be run every time new data is added. Debra's
suggestion plus my suggestion results in the ranges automatically
adjusting for data being added or removed.

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

On Jun 16, 1:19*am, GS wrote:
prkhan56 submitted this idea :





On Jun 16, 12:01*am, GS wrote:
Corrections:

* Cell A1="City", Cell B1="Town", Cell C1="State"
* Define A1 as...
* * Name="'Sheet name'!City_Hdr",
* * RefersTo="=$A$1"

* Define the list under "City_Hdr" as...
* * Name="'Sheet name'!City",
* * RefersTo="=OFFSET(City_Hdr,1,0,COUNTA($A:$A)-1,1)

* * Define B1 as...

* * Name="'Sheet name'!City_Hdr",
* * RefersTo="=$B$1"

* Define the list under "Town_Hdr" as...
* * Name="'Sheet name'!Town",
* * RefersTo="=OFFSET(Town_Hdr,1,0,COUNTA($B:$B)-1,1)

* * Define C1 as...

* * Name="'Sheet name'!State_Hdr",
* * RefersTo="=$C$1"

* Define the list under "State_Hdr" as...
* * Name="'Sheet name'!State",
* * RefersTo="=OFFSET(State_Hdr,1,0,COUNTA($C:$C)-1,1)

--
Garry

Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Hi Gary,
Thanks for your suggestion.
Claus has provided the code

Ok, but note that Claus's very nice code doesn't make the ranges
dynamic and so it must be run every time new data is added. Debra's
suggestion plus my suggestion results in the ranges automatically
adjusting for data being added or removed.

--
Garry

Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc- Hide quoted text -

- Show quoted text -

Hi Gary,
Thanks for your time and suggestion.