CODEWITHSUNDEEP
excelvba
karamell
karamell

Reputation: 713

VBA Excel: modify dynamic named range code

Newbie question: I have module, originally made by Roger Govier.

It uses an input cell header and creates a dynamic named range for the non empty cells positioned under header. The created named range will be labeled as the value of the header cell.

Private Sub CreateNamedRange(header As range)
   Dim wb As Workbook
   Dim WS As Worksheet
   Dim rStartCell As range
   Dim rData As range
   Dim rCol As range
   Dim lCol As Long
   Dim sSheet As String
   Dim Rowno As Long

   ' get table location
   Set rStartCell = header

   Set WS = rStartCell.Worksheet
   Set wb = WS.Parent
   sSheet = "'" & WS.Name & "'"
   With rStartCell
      Rowno = .row
      Set rData = .CurrentRegion
   End With
   Set rData = WS.range(rStartCell, WS.Cells(Rowno, rStartCell.Column))

    Set rCol = rData.Columns
    lCol = rCol.Column
    wb.Names.Add Name:=Replace(rCol.Cells(1).Value, " ", "_"), _
    RefersToR1C1:="=" & sSheet & "!" & rCol.Cells(2).Address(ReferenceStyle:=xlR1C1) & ":INDEX(C"        & lCol & ",LOOKUP(2,1/(C" & lCol & "<>""""),ROW(C" & lCol & ")))"

End Sub

I want to modify this code so that instead of creating a named range it only returns the returns the range of the what would have been the named range.

Example: We have a header in A1, and data in A2:A5.

Now: If we call CreateNamedRange(.range("A1")), it creates a dynamic named range for A2:A5.

Goal: If we call CreateNamedRange(.range("A1")) it returns .range("A2:A5") to a variable in the VBA code:

dim myRange As Range
set myRange = CreateNamedRange(.range("A1"))

Upvotes: 1

Views: 10551

Answers (2)

user2480047
user2480047

Reputation:

First thing you should note is that Subs do not return any value and thus myRange = CreateNamedRange(.range("A1")) does not make any sense (with your Sub; it does make sense with the Function in this answer).

The function below returns a range, in the same column that the input range, starting from the next row and including all the ones below until finding a blank cell. This range is called "anyName" (and thus you can access it via Range("anyName")).

Private Function CreateNamedRange(header As Range) As Range

   Dim curRow As Long: curRow = header.Row + 1
   Set tempRange = header.Worksheet.Cells(curRow, header.Column)
   Do While (Not IsEmpty(tempRange))
     curRow = curRow + 1
     Set tempRange = header.Worksheet.Cells(curRow, header.Column)
   Loop

   Set CreateNamedRange = header.Worksheet.Range(header.Worksheet.Cells(header.Row + 1, header.Column), header.Worksheet.Cells(curRow, header.Column))

   CreateNamedRange.Name = "anyName"

End Function

Upvotes: 2

grandocu
grandocu

Reputation: 326

If you already have the beginning cell activated you can just use

Set myRange = Range(ActiveCell.Address, ActiveCell.Offset.End(xlDown).Address)

to set your range for all entries below the active cell. If you don't have it activated, you can just use your rstartCell reference with an offset

Set myRange = Range(rStartCell.Offset(1), rStartCell.Offset(1).Offset.End(xlDown).Address)

Then you can just add the named range in the next line

Upvotes: 1

Related Questions