Automatically define a Variable Range using a macro

Abgar · Nov 25, 2009

Hi Guys,

I have asked this before but it wasn't really necessary at the time, so i didn't push it, but now it would be REALLY handy.
Theres a few points to this, so I'll make it easy to read

1. I need to define a variable range of all the USED cells in a column (starting at row 2 as the row 1 is the header)

2. I need to do this for columns A through to P inclusively (all using the same lastrow reference as that of column A)

3. I need to call the range name by the contents of the header in that column (Row 1)

4. Some of the data in the header row (row 1) contains spaces - can we change this to an underscore for the range name only?

5. Does a range only work for the active worksheet? Because i will have multiple worksheets, all with the exact same information in row 1, but different numbers of rows (and different data as well), but i will need the range defined on each worksheet......

I've found the following code and thought it was it, but it only defines on 1 worksheet, and for some reason only defines ranges for columns 1 and 2. Also it defines the range as A1:A65535 - not the USED range.....
Can anyone help me with this?

Code:

Sub Ranges()

Sheets("Shee1").Select
    
        Dim wb As Workbook, ws As Worksheet
        Dim lrow As Long, lcol As Long, i As Long
        Dim myName As String, Start As String
        Const Rowno = 1
        Const Offset = 1
        Const Colno = 1
        Set wb = ActiveWorkbook
        Set ws = ActiveSheet
        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
        myName = Replace(Cells(Rowno, i).Value, " ", "_")
        If myName = "" Then
           MsgBox "Fatal Error"
            Exit Sub
        End If
         wb.Names.Add Name:=myName, RefersToR1C1:= _
             "=R" & Rowno + Offset & "C" & i & ":INDEX(C" & i & ",lrow)"
nexti:
        Next i
End Sub

And lastly (I promise) if anyone CAN help me with any of the above, would it be too much to ask to also make a note about what each section of the code actually does? Just so that i can understand it for future use and that way, i can actually learn something from it, instead of just utilising it..

Thanks so much all.

Really appreciate you even reading all of this

Andrew Poulsom · Nov 25, 2009

Try:

Code:

Sub Test()
    Dim Sh As Worksheet
    Dim LR As Long
    Dim c As Long
    Dim Rng As Range
    For Each Sh In ActiveWorkbook.Worksheets
        With Sh
            LR = .Range("A" & .Rows.Count).End(xlUp).Row
            For c = 1 To 16
                .Range(.Cells(2, c), .Cells(LR, c)).Name = "'" & .Name & "'!" & Replace(.Cells(1, c).Value, " ", "_")
            Next c
        End With
    Next Sh
End Sub

Abgar · Nov 25, 2009

Thanks Andrew.

When running, I get a "Runtime Error 1004 - That name is not valid" error.
Is you code referencing the workbook name? Because some of the workbook names also have a space in it.....

Thanks so much

Abgar · Nov 25, 2009

NO WAIT - You've done it

Sorry, the used columns wasn't A-P yet, its only currently A-I. I changed from 16 to 9 and it works

Would it be possible to alter that at all so that it only tries to run on columns with data in it?

THANKS SO MUCH AGAIN ANDREW

Andrew Poulsom · Nov 25, 2009

Try:

Code:

Sub Test()
    Dim Sh As Worksheet
    Dim LR As Long
    Dim c As Long
    Dim Rng As Range
    For Each Sh In ActiveWorkbook.Worksheets
        With Sh
            LR = .Range("A" & .Rows.Count).End(xlUp).Row
            For c = 1 To 9
                Set Rng = .Range(.Cells(2, c), .Cells(LR, c))
                If WorksheetFunction.CountA(Rng) > 0 Then
                    Rng.Name = "'" & .Name & "'!" & Replace(.Cells(1, c).Value, " ", "_")
                End If
            Next c
        End With
    Next Sh
End Sub

Abgar · Nov 25, 2009

Andrew - I could literally kiss you right now

THANKS SO MUCH

the_original_invisible · Nov 25, 2009

Andrew's answer is brilliant. Short and snappy and I think I'll probably adapt a bit of it for use myself.

The original code you supplied was written by Roger Govier at Technology4U. I have adapted it a little to suit my (and your) requirements. I've also commented it so hopefully you can understand what is doing what. I like the fact that it uses dynamic rather than hard coded ranges, so for my purposes it works better.

Also, my headers are often not in row 1, as I tend to display results at the top of the page so that the end user doesn't have to scroll through thousands of rows to get to a total. By changing the "Const Rowno" then I can easily handle this. Anyway, here's the adapted code

'---------------------------------------------------------------------------------------
' Module : Module1
' Author : Roger Govier & Lee Armitage
' Date : 25/11/2009
' Purpose : To automatically create dynamic range names
'---------------------------------------------------------------------------------------

Option Explicit

Sub CreateNames()
' written by Roger Govier, Technology4U
' enhanced by Lee Armitage, Heath Lambert Group (leearmitage@gmail.com)
Dim wb As Workbook, ws As Worksheet
Dim lrow As Long, lcol As Long, i As Long
Dim myName As String, Start As String
Dim wsName 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

'replace blanks in worksheet names with underscore for the purposes of adding range names
wsName = ws.Name
wsName = Replace(wsName, " ", "_")

wb.Names.Add Name:=wsName & "_lcol", RefersTo:="=COUNTA($" & Rowno & ":$" & Rowno & ")"
wb.Names.Add Name:=wsName & "_lrow", RefersToR1C1:="=COUNTA(C" & Colno & ")"
wb.Names.Add Name:=wsName & "_myData", RefersTo:="=" & Start & ":INDEX($1:$65536," & wsName & "_lrow," & wsName & "_lcol)"

For i = Colno To lcol
' if a column header contains space or other invalid character etc, replace with underscore
myName = Replace(Cells(Rowno, i).Value, "/", "_")
myName = Replace(myName, " ", "_")
myName = Replace(myName, "&", "_")
myName = Replace(myName, "(", "_")
myName = Replace(myName, ")", "_")
myName = Replace(myName, "?", "_")
myName = Replace(myName, "\", "_")

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:=wsName & "_" & myName, RefersToR1C1:= _
"=R" & Rowno + Offset & "C" & i & ":INDEX(C" & i & "," & wsName & "_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/Lee Armitage"

End Sub

Hopefully it might help someone in the future

Cheers

Lee

Abgar · Nov 28, 2009

With special thanks to Andrew Poulsom for the above

.

Just a quick add-in, is it possible to define the last row of the range as 'The longest column of either Column A or column Z?

I.e, if the Zolumn Z is longer than column A, (which it will be sometimes), then define the range as using the lastrow of comlumn Z instead of A?

Thanks again

Abgar · Nov 28, 2009

Edit - actually, I think the better way to go will be to use the above code, and then define a new range for column Z (defining the USED range only for column Z) - and I will also need one for column AA (using the lastrow for column AA).

Would this be done just be repeating the above code from Andrew but changing the column / lastrow reference?

Or could my new requirement just be added into the existing code to make it neater and easier....

Thanks as always

Andrew Poulsom · Nov 29, 2009

Maybe try:

Code:

Sub Test()
    Dim Sh As Worksheet
    Dim LR As Long
    Dim c As Long
    Dim Rng As Range
    For Each Sh In ActiveWorkbook.Worksheets
        With Sh
            LR = .Range("A" & .Rows.Count).End(xlUp).Row
            For c = 1 To 9
                Set Rng = .Range(.Cells(2, c), .Cells(LR, c))
                If WorksheetFunction.CountA(Rng) > 0 Then
                    Rng.Name = "'" & .Name & "'!" & Replace(.Cells(1, c).Value, " ", "_")
                End If
            Next c
            LR = .Range("Z" & .Rows.Count).End(xlUp).Row
            Set Rng = .Range(.Cells(2, 26), .Cells(LR, 26))
            Rng.Name = "'" & .Name & "'!" & Replace(.Cells(1, c).Value, " ", "_")
            LR = .Range("AA" & .Rows.Count).End(xlUp).Row
            Set Rng = .Range(.Cells(2, 27, .Cells(LR, 27))
            Rng.Name = "'" & .Name & "'!" & Replace(.Cells(1, c).Value, " ", "_")
        End With
    Next Sh
End Sub

Automatically define a Variable Range using a macro

Abgar

Active Member

Andrew Poulsom

MrExcel MVP

Abgar

Active Member

Abgar

Active Member

Andrew Poulsom

MrExcel MVP

Abgar

Active Member

the_original_invisible

Board Regular

Abgar

Active Member

Abgar

Active Member

Andrew Poulsom

MrExcel MVP

Similar threads

Share this page

Automatically define a Variable Range using a macro

Active Member

MrExcel MVP

Active Member

Active Member

MrExcel MVP

Active Member

Board Regular

Active Member

Active Member

MrExcel MVP

Similar threads

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock