VBA modification help needed from earlier solution by Rgonzo1971 Dynamic Rng

I had this question after viewing VBA modification help needed from earlier solution by Rgonzo1971 Dynamic Range.


Rgonzo1971 helped me with the code below.

it created dynamic ranges where column and rows are both dynamic.

i used the named ranges created by this macro inside the formulas and it really killed my excel processors and went i did some research, it was becuase of use of offset.

Now, i have found a better way of creating dynamic range, i have uploaded a copy of workbook with my ideal dynamic range.
however, i could not modify the code below, so that it creates the dynamic range as per the attached workbook using INDEX and not offset.

so here are the steps.

lets say, i selected the four columns from A to D from the attached workbook.

1- the macro first should create a named range for entire sheet. named name of sheet sht.name which is "Data" refers to  =Data!$1:$1048576
so in VBA code below it would be something like    =sht.Name & "!$1:$1048576

2- second it should create a lastrow named range named as sheet name & Lrow  so the named range name will be for this example  DataLrow and it will refer to =LOOKUP(9.99999999999999E+307,1/(1-ISBLANK(Data!$A:$A)),ROW(Data!$A:$A))
so in the VBA code it would be something like =LOOKUP(9.99999999999999E+307,1/(1-ISBLANK(sht.Name & "!$A:$A)),ROW(sht.Name & "!$A:$A))

these two abovementioned named ranges are as helper named ranges to be used inside the actual named ranges

3- the rest will be the loop to create the actual named range for each selected column, the named range name will be strShName & strHdrName and they should refer to =INDEX(Data,2,MATCH(""" & Cells(1, c) & """,INDEX(Data,1,0),0)):INDEX(Data,DataLrow,MATCH(""" & Cells(1, c) & """,INDEX(Data,1,0),0))

please note that Data inside INDEX and DataLrow inside Index are the named ranges created in 1 & 2 steps outside the loop.


i tried by myself , but i could not modify the code. any help is appreciated.

 Sub Create_RangeNames1()
     'Creates dynamic named ranges based on header row information only Selection
    Dim wbk As Workbook
    Dim sht As Worksheet
    Dim rng, rng2 As Range
    Dim cl As Range 'Object
    Dim c As Long
    Dim strAddr As Variant
    Dim strShName, strHdrName, strCol As String
    
    Set wbk = ActiveWorkbook
    Set sht = ActiveSheet
    Set rng = Selection
    For c = rng.Column To rng.Column + rng.Columns.Count - 1
        If Cells(1, c).Value <> "" Then
            strShName = Replace(sht.Name, " ", "_", 1)
            strHdrName = Replace(Cells(1, c).Value, " ", "_", 1)
            strCol = Cells(2, c).EntireColumn.Address
            Set rng2 = sht.Range(Cells(, c), Cells(1, c).End(xlDown))
             wbk.Names.Add Name:=strShName & strHdrName, _
                RefersTo:="=OFFSET(" & sht.Name & "!$A$2,0,MATCH(""" & Cells(1, c) & """," & sht.Name & "!$1:$1,0)-1,SUMPRODUCT(MAX((OFFSET(" & sht.Name & "!$A:$A,0,MATCH(""" & Cells(1, c) & """," & sht.Name & "!$1:$1,0)-1)<>"""")*ROW(OFFSET(" & sht.Name & "!$A:$A,0,MATCH(""" & Cells(1, c) & """," & sht.Name & "!$1:$1,0)-1))))-1,1)"
                
       End If
    Next
End Sub

Open in new window

EE.xlsx
LVL 6
FloraAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Martin LissOlder than dirtCommented:
If you meant to include code in that workbook it didn't happen because an xlsx workbook can't contain code. If you want us to see the code, please re-save the the source file as EE.xlsm.
0
FloraAuthor Commented:
Martin,

you can see the code already. i pasted it there in original post. Sub Create_RangeNames1()

i need help to modify it.
0
Martin LissOlder than dirtCommented:
The code is probably because of the huge size of the 'Data' named range which has a formula of =Data!$1:$1048576 which means that it includes over a million rows and a large number of columns. If the number of rows doesn't change then use =Data!$A$1:$E$3924 instead. If it does then you should use a formula that contains OFFSET, and if you don't want to do that then at least change the 1048576 to some value that's much less than that but will still hold your maximum number of rows.

Actually since your Data named range is all your data, you don't need a named range at all, just use UsedRange.
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Martin LissOlder than dirtCommented:
Without specifying how to do it, can you describe what it is that you want to do with the data?
0
Rgonzo1971Commented:
Hi,

pls try
 Sub Create_RangeNames1()
     'Creates dynamic named ranges based on header row information only Selection
    Dim wbk As Workbook
    Dim sht As Worksheet
    Dim rng, rng2 As Range
    Dim cl As Range 'Object
    Dim c As Long
    Dim strAddr As Variant
    Dim strShName, strHdrName, strCol As String
    
    Set wbk = ActiveWorkbook
    Set sht = ActiveSheet
    Set rng = Selection
    
    wbk.Names.Add Name:="rData", RefersTo:="='" & sht.Name & "'!$1:$1048576"
    wbk.Names.Add Name:="Lrow", RefersTo:="=LOOKUP(9.99999999999999E+307,1/(1-ISBLANK('" & sht.Name & "'!$A:$A)),ROW('" & sht.Name & "'!$A:$A))"
    
    For c = rng.Column To rng.Column + rng.Columns.Count - 1
        If Cells(1, c).Value <> "" Then
            strShName = Replace(sht.Name, " ", "_", 1)
            strHdrName = Replace(Cells(1, c).Value, " ", "_", 1)
            strCol = Cells(2, c).EntireColumn.Address
            Set rng2 = sht.Range(Cells(, c), Cells(1, c).End(xlDown))
             wbk.Names.Add Name:=strShName & strHdrName, _
                RefersTo:="=OFFSET(INDIRECT(ADDRESS(2,MATCH(""" & Cells(1, c) & """,INDEX(rData,1,0),0))),,,Lrow-1)"
                'or '"=INDIRECT(ADDRESS(2,MATCH(""" & Cells(1, c) & """,INDEX(rData,1,0),0))&"":""&ADDRESS(Lrow,MATCH(""" & Cells(1, c) & """,INDEX(rData,1,0),0)))"
       End If
    Next
End Sub

Open in new window

Regards
1

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
FloraAuthor Commented:
thank you very much Rgonzo1971.  

it worked. i also learned form you the Technic on how to modify the code. thanks alot of that.

i was playing around with your code that lead me also create the one only with use of INDEX.  i was told by Aladin that i should avoid using offset which is more volatile  and INDEX Is much better.

so i constructed from you code the below one.  please let me know, if i did miss anything.  it looks like it is working.

 Sub Create_RangeNames1()
    Dim wbk As Workbook
    Dim sht As Worksheet
    Dim rng, rng2 As Range
    Dim cl As Range 'Object
    Dim c As Long
    Dim strAddr As Variant
    Dim strShName, strHdrName, strCol As String
    
    Set wbk = ActiveWorkbook
    Set sht = ActiveSheet
    Set rng = Selection
    
    wbk.Names.Add Name:=sht.Name, RefersTo:="='" & sht.Name & "'!$1:$1048576"
    wbk.Names.Add Name:=sht.Name & "Lrow", RefersTo:="=LOOKUP(9.99999999999999E+307,1/(1-ISBLANK('" & sht.Name & "'!$A:$A)),ROW('" & sht.Name & "'!$A:$A))"
    
    For c = rng.Column To rng.Column + rng.Columns.Count - 1
        If Cells(1, c).Value <> "" Then
            strShName = Replace(sht.Name, " ", "_", 1)
            strHdrName = Replace(Cells(1, c).Value, " ", "_", 1)
            strCol = Cells(2, c).EntireColumn.Address
            Set rng2 = sht.Range(Cells(, c), Cells(1, c).End(xlDown))
             wbk.Names.Add Name:=strShName & strHdrName, _
                RefersTo:="=INDEX(" & sht.Name & ",2,MATCH(""" & Cells(1, c) & """,INDEX(" & sht.Name & ",1,0),0)):INDEX(" & sht.Name & "," & sht.Name & "Lrow,MATCH(""" & Cells(1, c) & """,INDEX(" & sht.Name & ",1,0),0))"
       End If
    Next
End Sub

Open in new window

0
Rgonzo1971Commented:
If it works for you, better this way (so you understand what you're doing)
1
FloraAuthor Commented:
thank you Rgonzo1971
0
FloraAuthor Commented:
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.