• Status: Solved
  • Priority: Low
  • Security: Public
  • Views: 56
  • Last Modified:

VBA modification help needed from earlier solution by Rgonzo1971 Dynamic Range

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


Rgonzo1971 was so kind helping with this great piece of code.

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 & "'!" & Cells(2, c).Address & ",0,0,SUMPRODUCT(MAX(('" & sht.Name & "'!" & strCol & "<>"""")*ROW('" & sht.Name & "'!" & strCol & ")))-1,1)"
       End If
    Next
End Sub

Open in new window


lets say from the attached file .  i selected column E and run the above code.  it created named range with this formua.
=OFFSET(Sheet1!$E$2,0,0,SUMPRODUCT(MAX((Sheet1!$E:$E<>"")*ROW(Sheet1!$E:$E)))-1,1)

i need help with modifying this, so that it creates the column dynamic formula  like this.  

so the "ORDER ID" inside Match function should take from column header name

=OFFSET(Sheet1!$A$2,0,MATCH("ORDER ID",Sheet1!$1:$1,0)-1,COUNTA(OFFSET(Sheet1!$A:$A,0,MATCH("ORDER ID",Sheet1!$1:$1,0)-1))-1,1)
EE.xlsb
0
Flora
Asked:
Flora
  • 8
  • 3
1 Solution
 
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
    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).Value & ",'" & sht.Name & "'!$1:$1,0)-1,COUNTA(OFFSET(Sheet1!$A:$A,0,MATCH(" & Cells(1, c).Value & ",'" & sht.Name & "'!$1:$1,0)-1))-1,1)"
       End If
    Next
End Sub

Open in new window

Regards
0
 
FloraAuthor Commented:
thank you very much.

sorry if i confused you with my poor explanation.  i am trying to avoid use of COUNTA  instead i want to use, the one with sumproduct.

SUMPRODUCT(MAX((OFFSET(Sheet1!$A:$A,0,MATCH("ORDER ID",Sheet1!$1:$1,0)-1)<>"")*ROW(OFFSET(Sheet1!$A:$A,0,MATCH("ORDER ID",Sheet1!$1:$1,0)-1))))-
0
 
FloraAuthor Commented:
sorry the comlete formula should be =OFFSET(Sheet1!$A$2,0,MATCH("ORDER ID",Sheet1!$1:$1,0)-1,SUMPRODUCT(MAX((OFFSET(Sheet1!$A:$A,0,MATCH("ORDER ID",Sheet1!$1:$1,0)-1)<>"")*ROW(OFFSET(Sheet1!$A:$A,0,MATCH("ORDER ID",Sheet1!$1:$1,0)-1))))-1,1)   which will be generated from  VBA

also the "ORDER ID" inside Match function should take from column header name
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.

 
Rgonzo1971Commented:
then 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
    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

1
 
FloraAuthor Commented:
thanks very much.

it works. but it puts the formula as this .  so the header name inside the Match is not within qoutation marks " "  that is why it is not recognized.

=OFFSET(Sheet1!$A$2,0,MATCH(Product Name,Sheet1!$1:$1,0)-1,SUMPRODUCT(MAX((OFFSET(Sheet1!$A:$A,0,MATCH(Product Name,Sheet1!$1:$1,0)-1)<>"")*ROW(OFFSET(Sheet1!$A:$A,0,MATCH(Product Name,Sheet1!$1:$1,0)-1))))-1,1)
0
 
FloraAuthor Commented:
so if it generates like this =OFFSET(Sheet1!$A$2,0,MATCH("Product Name",Sheet1!$1:$1,0)-1,SUMPRODUCT(MAX((OFFSET(Sheet1!$A:$A,0,MATCH("Product Name",Sheet1!$1:$1,0)-1)<>"")*ROW(OFFSET(Sheet1!$A:$A,0,MATCH("Product Name",Sheet1!$1:$1,0)-1))))-1,1)

then it works. i do not know how to put the " " around the Cells(1, c)
0
 
Rgonzo1971Commented:
then 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
    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

1
 
FloraAuthor Commented:
This is by far one of the greatest solutions received from you.  Thanks a Billion!  very much appreciated.
0
 
FloraAuthor Commented:
you are amazing! Rgonzo1971
0
 
FloraAuthor Commented:
Thank you so much. Thanks very very much.
0
 
FloraAuthor Commented:
dear Rgonzo1971

you have written this line of code  Set rng2 = sht.Range(Cells(, c), Cells(1, c).End(xlDown))  

but i have not seen where did you use it, in the following lines of code.   can u please tell me why you created this rng2?
0
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.

Join & Write a Comment

Featured Post

Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

  • 8
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now