Named Range VBA

Hello All,

I have a named range VBA question
Is it possible via VBA to go across a specific row (row  = 4) and find the leftmost and rightmost cells and then create name range “myRng” with those cells – I am looking for a VBA way of doing this…

Thank you
namedRangeCreateHow.xlsx
RayneAsked:
Who is Participating?
 
Elton PascuaCommented:
Here's how I would do it:

Option Explicit

Sub FindAndName()
    
    Dim wb As ThisWorkbook
    Dim ws As Worksheet
    Dim leftStr As String
    Dim rightstr As String
    Dim leftRng As Range
    Dim rightRng As Range
    Dim rangeToName As Range
    Dim myRng As Range
    
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet1")
    
    leftStr = "C1"
    rightstr = "C4"
    
    On Error GoTo Errhandler:
    Set leftRng = ws.UsedRange.Find(What:=leftStr, LookIn:=xlValues, SearchOrder:=xlByRows, Searchdirection:=xlPrevious)
    Set rightRng = ws.UsedRange.Find(What:=rightstr, LookIn:=xlValues, SearchOrder:=xlByRows, Searchdirection:=xlPrevious)
    Set rangeToName = ws.Range(leftRng, rightRng)
    
    On Error Resume Next
    Set myRng = ws.Range("myrng")
    On Error GoTo 0
    
    If myRng Is Nothing Then
        ws.Names.Add Name:="myrng", RefersTo:=rangeToName
    Else
        wb.Names("myrng").Delete
        ws.Names.Add Name:="myrng", RefersTo:=rangeToName
    End If
    
    Exit Sub
Errhandler:
MsgBox ("Headings not found.")
End Sub

Open in new window

0
 
RayneAuthor Commented:
so for cell range C1: C4, create the named range via VBA
But first locate the leftmost and rightmost cells in row 4
0
 
RayneAuthor Commented:
I did this but still getting error
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.

 
RayneAuthor Commented:
Sub Button1_Click()

Dim fixedHeaderRow As Long


Dim f1, f2 As String

f1 = FirstColumn(ActiveSheet)
f2 = LastColumn(ActiveSheet)

'ActiveWorkbook.Names.Add Name:="myRng", RefersTo:="Sheet1!A2:A" & Range("A2").End(xlDown).Row

ActiveWorkbook.Names.Add Name:="myRng", RefersTo:="Sheet1!" & f1 & ":" f2




End Sub


Private Function FirstColumn(TheWorksheet As Worksheet) As String

If WorksheetFunction.CountA(TheWorksheet.Cells) > 0 Then
    FirstColumn = Replace((Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlNext).Address), "$", "")
End If

End Function



Private Function LastColumn(TheWorksheet As Worksheet) As String
If WorksheetFunction.CountA(TheWorksheet.Cells) > 0 Then
    LastColumn = Replace((Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Address), "$", "")
End If
End Function

Open in new window

0
 
RayneAuthor Commented:
I am not still getting it, please assist
0
 
Anthony BerenguelCommented:
Hi Rayne,

Give this a shot...
Public Function setNamedRangeInRow4()

    'WRITTEN BY:    AEBEA
    'WRITTEN ON:    2012.08.22
    'FOR QUESTION:  http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Q_27839201.html
    
    Dim currentCellColumnIndex As Integer
    Dim leftMostColumn As Integer
    Dim rightMostColumn As Integer
    
    'GET THE RANGE
    For Each cell In Range("4:4")
        If Len(cell) > 0 Then
            'get the column of the cell
            currentCellColumnIndex = cell.Column
            If leftMostColumn = 0 Then
                leftMostColumn = currentCellColumnIndex
            ElseIf currentCellColumnIndex < leftMostColumn Then
                leftMostColumn = currentCellColumnIndex
            ElseIf currentCellColumnIndex > rightMostColumn Then
                rightMostColumn = currentCellColumnIndex
            End If
        Else
        
        End If
    Next
    Debug.Print "LEFTMOST CELL COLUMN: " & leftMostColumn
    Debug.Print "RIGHTMOST CELL COLUMN: " & rightMostColumn
    'CREATE THE NAMED RANGE
    ActiveWorkbook.Names.Add Name:="this_named_range", RefersToR1C1:= _
        "=Sheet1!R4C" & leftMostColumn & ":R4C" & rightMostColumn
End Function

Open in new window

0
 
Saqib Husain, SyedEngineerCommented:
Here is my take

Sub getcolhdrs()
dim fc as range, lc as range, hdrrng as range
Set fc = ActiveSheet.Range("4:4").Find("*", Cells(4, Columns.Count), , , , xlNext)
Set lc = ActiveSheet.Range("4:4").Find("*", Cells(4, 1), , , , xlPrevious)
Set hdrrng = Range(fc.Address, lc.Address)
End Sub
0
 
RayneAuthor Commented:
Hello All,

Thank you for the deferent approaches. :)

techfanatic ‘s code was complete except for he  assumed the left and right cells are C1:C4. On the other hand,, Ssaqib showed the quickest way to locate the left and right cells
 while Aebea iterated through all the cells in the header row. Good to know all the different approaches.

Thanks guys for the platinum help.
0
 
Elton PascuaCommented:
Edit: Nevermind, I misread the post.
0
 
RayneAuthor Commented:
A relevant follow up posted here if you are interested
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Q_27841478.html

Thank you
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.

All Courses

From novice to tech pro — start learning today.