VBA modification help needed to revise the formula
I have this best code. also in the attached workbook.
if you select the column A and then run this macro. it will add a dynamic named range =OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A),1)
i need help with modification of VBA code that instead of creating =OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A),1) I need the VBA to Create this =OFFSET(Sheet1!$A$2,0,0,SUMPRODUCT(MAX((Sheet1!$A:$A<>"")*ROW(Sheet1!$A:$A)))-1,1)
how can this code below be modified?
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 = 1 To rng.Columns.Count If Cells(1, c).Value <> "" Then strShName = Replace(sht.Name, " ", "_", 1) strHdrName = Replace(Cells(1, c).Value, " ", "_", 1) strAddr = Split(Cells(1, c).Address, "$") strCol = "$" & strAddr(1) & ":$" & strAddr(1) Set rng2 = sht.Range(Cells(, c), Cells(1, c).End(xlDown)) wbk.Names.Add Name:=strShName & strHdrName, _ RefersTo:="=OFFSET('" & sht.Name & "'!" & Cells(1, c).Address & ",0,0,COUNTA('" & _ sht.Name & "'!" & strCol & "),1)" End If NextEnd Sub
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 = 1 To rng.Columns.Count If Cells(1, c).Value <> "" Then strShName = Replace(sht.Name, " ", "_", 1) strHdrName = Replace(Cells(1, c).Value, " ", "_", 1) strAddr = Split(Cells(1, c).Address, "$") strCol = "$" & strAddr(1) & ":$" & strAddr(1) Set rng2 = sht.Range(Cells(, c), Cells(1, c).End(xlDown)) wbk.Names.Add Name:=strShName & strHdrName, _ RefersTo:="=OFFSET('" & sht.Name & "'!" & Cells(1, c).Address & ",0,0,SUMPRODUCT(MAX(('" & sht.Name & "'!" & strCol & "<>"""")*ROW('" & sht.Name & "'!" & strCol & ")))-1,1)" End If NextEnd Sub
pls try
Open in new window
EDIT corrected codeRegards