Urgent Help needed creating dynamic named ranges using VBA

jamilm

Well-known Member
Joined
Jul 21, 2011
Messages
740
Gurus,

I have two codes that creates dynamic ranges. Very useful. However, there is one big issue that i could not solve it myself.

two problems and both of them can be fixed with one improvement by any of you Champs!


if i use any of the two code below. for example i am creating dynamic named ranges for 3 sheets in a workbook. by running this code on each activesheet it would create the names.
however the major problem will be that it will always refer Name:="lcol" & Name:="lrow" to the last sheet for which named ranges were created.
what i need is , modification improvement in either of the codes below, is that, the named ranges shall have the sheet name as part of the created name, so that it can be differentiated and understood that what names is from what sheets. also the Name:="lcol" & Name:="lrow" for each sheet to be relevant to their respective sheets and used inside thier relvant named range. for example named range against sheet1 column A Header/firstrow Name is "Product" and therefore the name to be created like "Sheet1Product". Now, the lrow and lcol for sheet1 shall refer Sheet1lcol and Sheet1lrow inside the formula in the named range of "Sheet1Product" like this =Sheet1Product!$A$2:INDEX(Sheet1Product!$A:$A,Sheet1lrow)

thank you. your help is appreciated as usual.



code 1
Code:
Sub CreateNamesxx()
'Update 20131128
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 Colno = 1
Const Offset = 1
On Error Resume Next
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:$1048576," & "lrow," & "Lcol)"
For i = Colno To lcol
myName = Replace(Cells(Rowno, i).Value, " ", "_")
If myName <> "" Then
wb.Names.Add Name:=myName, RefersToR1C1:="=R" & Rowno + Offset & "C" & i & ":INDEX(C" & i & ",lrow)"
End If
Next
End Sub

code2

Code:
Option Explicit
' Downloaded from [URL="http://www.contextures.com"]www.contextures.com[/URL]
Sub CreateNames()
' 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 ROffset = 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
    
    ' Set an Offset from the starting column, for the column number that
    ' will always have data entered, and will therefore be used in calculating lrow
    
    Const COffset = 0  ' in this case, the first column will always contain data.
    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 = Cells(Rowno, Columns.Count).End(xlToLeft).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 + COffset & ")"
    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 + ROffset & "C" & i & ":INDEX(C" & i & ",lrow)"
nexti:
    Next i
    On Error GoTo 0
        MsgBox "All dynamic Named ranges have been created"
    Exit Sub
    Exit Sub
CreateNames_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & _
    ") in procedure CreateNames of Module Technology4U"
End Sub
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
I don't know if this will help for sure, but you can do names with Name:="lcol" & i , allowing for simple names and running through For Each ws.
 
Upvote 0

Forum statistics

Threads
1,215,066
Messages
6,122,947
Members
449,095
Latest member
nmaske

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top