Excel VBA: Reference a named range, like one would reference a chart or table

Viewed 213

I have:

    Dim xlBook as Workbook
    Dim xlSheet as Worksheet
    Dim xlTable as ListObject
    Dim xlTable Column as ListColumn
    Dim xlChartObject as ChartObject
    Dim xlTableObject as ListObject
    
    Dim ObjectArray() as String
    Dim ObjectIndexArray as Integer
    
    'set the book'
    Set xlBook = ThisWorkbook
    
    'loop through each worksheet'
    For each xlSheet in XlBook.Worksheets
    
    'if we have charts
    if xlSheet.ChartObjects.Count > 0 then
    
    'grab each name
    For each xlChartObject in xlSheet.ChartObjects
    
    'update count
    ObjectArrayIndex = ObjectArrayIndex + 1
    ReDim Preserve ObjectArray(ObjectArrayIndex)
    
    'add chart object to array
    ObjectArray(ObjectArrayIndex) = xlChartObject.Name & "-" & xlSheet.Name & "-" & TypeName(xlChartObject)

'grab sheet
    set xlSheet = xlBook.Worksheets("Export")
'grab table from sheet
    set xlTable = xlSheet.ListObjects("ExportToPowerPoint")
'grab object column from table
    Set xlTableColumn = xlTable.ListColumns("Object")
'set validation dropdown
    With xlTableColumn.DataBodyRange.Validation
'delete old
    .delete
'add new data
    .add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(ObjectArray, "-")
'make sure its a dropdown
    .InCellDropdown = true

    end with

    end sub

This code works well for grabbing charts, and similarly I utilized ListObject in order to then grab tables as well.

My Issue comes with creating another block of code to grab named ranges in excel. So not Tables or Charts

Any help would be greatly appreciated!

2 Answers

Activesheet.names should give array of named ranges on activeshee. Add that to for each loop and you should be done.

Names: Name, Range, Range Address

  • When you select a range in Excel and you use Name a range - Define name and you enter the name and press Ok, the name is 'saved' in workbook scope. So this code applies to workbook scope.
  • If you need to handle named ranges of worksheet scope (e.g. when you're using the same names on different worksheets), you will have to write the code somewhat differently.
  • The 'grab' procedures (Subs) illustrate how to return all names, range addresses and ranges (range objects) in an array and then print the contents (the Address property for ranges) to the Immediate window.
  • The 'get' procedure (Function) returns the array of the names and you could say it is the first 'grab' procedure written as a function.
  • The last procedure tests the function.
  • Here is another post I recently did on Names with links to some study material at the beginning.

The Code

Option Explicit

Sub grabNameNames()
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim nmsCount As Long: nmsCount = wb.Names.Count
    Dim nms() As String: ReDim nms(1 To nmsCount)
    Dim nm As Name
    Dim n As Long
    For Each nm In wb.Names
        n = n + 1
        nms(n) = nm.Name
    Next nm
    If Not IsEmpty(nms) Then
        Debug.Print Join(nms, vbLf)
    End If
End Sub

Sub grabNameAddresses()
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim nmsCount As Long: nmsCount = wb.Names.Count
    Dim nma() As String: ReDim nma(1 To nmsCount)
    Dim nm As Name
    Dim n As Long
    For Each nm In wb.Names
        n = n + 1
        nma(n) = nm.RefersToRange.Address(0, 0)
    Next nm
    If Not IsEmpty(nma) Then
        Debug.Print Join(nma, vbLf)
    End If
End Sub

Sub grabNameRanges()
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim nmsCount As Long: nmsCount = wb.Names.Count
    Dim nmr As Variant: ReDim nmr(1 To nmsCount)
    Dim nm As Name
    Dim n As Long
    For Each nm In wb.Names
        n = n + 1
        Set nmr(n) = nm.RefersToRange
    Next nm
    If Not IsEmpty(nmr) Then
        For n = 1 To UBound(nmr)
            Debug.Print nmr(n).Address
        Next n
    End If
End Sub

Function getNameNames(wb As Workbook)
    Dim nmsCount As Long: nmsCount = wb.Names.Count
    Dim nms() As String: ReDim nms(1 To nmsCount)
    Dim nm As Name
    Dim n As Long
    For Each nm In wb.Names
        n = n + 1
        nms(n) = nm.Name
    Next nm
    getNameNames = nms
End Function

Sub TESTgetNameNames()
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim Data As Variant: Data = getNameNames(wb)
    If Not IsEmpty(Data) Then
        Debug.Print Join(Data, vbLf)
    End If
End Sub
Related