VBA Named Range most efficient way to check if name exists

Question

I have a routine, that fills a calendar with all important events for the commodity markets for each day of the following week. I have a calendar grid laid out on the page and have ten named cells for each day i.e. Monday1, Monday2 and so on (each day only goes up to 10 for now, i.e.Monday10), in each days column. BTW the cells are 2 cells wide and 2 cells deep. Many times there are more than 10 events for a given day. I am trying to test for the named range to see if it exists, if not copy the format of the last named range cell and name that cell the next name in the series.

I am only having two issues with the above, first and foremost is how to test to determine in a name for a named range already exists. I am currently iterating thru the entire list of ThisWorkbook.Names, which has thousands of named ranges in it. Since this iteration could be running over 100 times when the calendar is generating, it is wicked slow (as would be expected). Is there a better, faster way to check if a name already exists as a named range?

The second issue is how to copy the formatting of a 4 cell, merged cell, since the address always comes up as only the top left corner cell so offsetting the range doesn't work appropriately. I hacked around to get this code to at least come up with the right range for the next merged cell group in the column

Set cCell = Range("Thursday" & CStr(y))
'even tho cCell is a 4 cell merged cell, cCell.Address returns the address of top left cell
Set destRange = Range(cCell.Address & ":" & cCell.offset(2, 0).offset(0, 1).Address)

Recording a macro to drag the formatting down, shows this code.

Range("G22:H23").Select
Selection.AutoFill Destination:=Range("G22:H25"), Type:=xlFillFormats
Range("G22:H25").Select

Since Range("G22:H23") is the same as cCell, and Range("G22:H25") is the same as destRange. The following code should work, but doesn't.

Set cCell = Range("Thursday" & CStr(y))
Set destRange = Range(cCell.Address & ":" & cCell.offset(2, 0).offset(0, 1).Address)
cCell.AutoFill Destination:=destRange, Type:=xlFillFormats
Application.CutCopyMode = False
cCell.offset(1, 0).Name = rangeName

FYI, it doesn't work if I select cCell and use Selection.AutoFill either.

Any thoughts on how to copy that cell formatting down the column one cell at a time when needed?

Update:

This now works for copying the formatting down from one merged cell to another of same size. For some reason setting destRange to the whole range (the copy cell and pastecell entire range as the macro recorder showed) didnt work but setting destRange to the cell range that needed formatting, and then doing a union of cCell and destRange worked, and made naming the new range easier.

rangeName = "Friday" & CStr(y + 1)
priorRangeName = "Friday" & CStr(y)
namedRangeExist = CheckForNamedRange(rangeName)
If namedRangeExist = False Then
    Set cCell = Range(priorRangeName) 
    Set destRange = Range(cCell.offset(1, 0).Address & ":" & cCell.offset(2, 0).offset(0, 1).Address)
    cCell.AutoFill Destination:=Union(cCell, destRange), Type:=xlFillFormats
    Application.CutCopyMode = False
    destRange.Name = rangeName
End If

Update #2

There is an issue with naming ranges in a For loop ( the code below is running inside a For loop). The first time the new rangeName is not found, Setting cCell to the prior range name and running through the code to copy the merged cell format and name the new range works fine. Here is the code

rangeName = "Thursday" & CStr(y + 1)
priorRangeName = "Thursday" & CStr(y)
namedRangeExist = DoesNamedRangeExist(rangeName)
If namedRangeExist = False Then
    Set cCell = Range(priorRangeName)
    Debug.Print "cCell:" & cCell.Address
    Set cCell = cCell.MergeArea
    Debug.Print "Merged cCell:" & cCell.Address
    Set destRange = Range(cCell.offset(1, 0).Address & ":" & cCell.offset(2, 0).offset(0, 1).Address)
    Debug.Print "Dest:" & destRange.Address
    Debug.Print "Unioned:" & Union(cCell, destRange).Address
    cCell.AutoFill Destination:=Union(cCell, destRange), Type:=xlFillFormats
    Application.CutCopyMode = False
    destRange.name = rangename
End If

results in the following ranges

cCell:$G$22

Merged cCell:$G$22:$H$23

Dest:$G$24:$H$25

Unioned:$G$22:$H$25

but if more than one new named range needs to be created the second time thru this code produces a range area as evidenced by the output shown below

cCell:$G$24:$H$25

so why does cCell's address show as only the upper left cells address when run the first time, but the second time thru cCell's address is shown as the whole merged cell range? And because it does, the next code line produces a range object error

Set cCell = cCell.MergeArea

Eliminating that code line and amending the first Set cCell to this;

Set cCell = Range(priorRangeName).MergeArea

produces the same error. I could kludge this by setting a counter, and if more than one, bypass that code line but that is not the preferred solution.

Answer 1

First and foremost, create a function to call the named range. If calling the named range generate an error the function will return False otherwise it will return True.

Function NameExist(StringName As String) As Boolean
    Dim errTest As String

    On Error Resume Next

    errTest = ThisWorkbook.Names(StringName).Value

    NameExist = CBool(Err.Number = 0)

    On Error GoTo 0
End Function

As for your second question, I had not problem with the autofill.

I would replce Set destRange = Range(cCell.Address & ":" & cCell.offset(2, 0).offset(0, 1).Address) with Set destRange = cCell.Resize(2,1). It has the same effect but the later is much cleaner.

Answer 2

Application.Evaluate and Worksheet.Evaluate can be used to get error value instead of error :

If Not IsError(Evaluate("Monday1")) Then             ' if name Monday1 exists

---

The error can be ignored or jumped over (but that can result in hard to detect errors) :

 On Error GoTo label1
   ' code that can result in error here
 label1:
 If Err.Number <> 0 Then Debug.Print Err.Description ' optional if you want to check the error
 On Error GoTo 0                                     ' to reset the error handling

---

Range.MergeArea can be used to get the Range of merged cell.

Answer 3

I created a function to extend the name ranges and fill in the formatting. The first named range in the series will have to be setup. The Name itself needs to be set to the top left cell in the merged area.

ExtendFillNamedRanges will calculate the positions of the named ranges. If a cell in one of the positions isn't part of a MergedArea it will fill the formatting down from the last named range. It will name that cell. The scope of the names is Workbook.

Sub ExtendFillNamedRanges(BaseName As String, MaxCount As Integer)
    Dim x As Integer, RowCount As Integer, ColumnCount As Integer

    Dim LastNamedRange As Range, NamedRange As Range

    Set NamedRange = Range(BaseName & 1)

    RowCount = NamedRange.MergeArea.Rows.Count
    ColumnCount = NamedRange.MergeArea.Columns.Count

    For x = 2 To MaxCount
        Set NamedRange = NamedRange.Offset(RowCount - 1)
        If Not NamedRange.MergeCells Then
            Set LastNamedRange = Range(BaseName & x - 1).MergeArea
            LastNamedRange.AutoFill Destination:=LastNamedRange.Resize(RowCount * 2, ColumnCount), Type:=xlFillDefault
            NamedRange.Name = BaseName & x

        End If

        'NamedRange.Value = NamedRange.Name.Name
    Next

End Sub

Here is the test that I ran.

Sub Test()
    Application.ScreenUpdating = False
    Dim i As Integer, DayName As String

    For i = 1 To 7
        DayName = WeekDayName(i)

        Range(DayName & 1).Value = DayName & 1

        ExtendFillNamedRanges DayName, 10
    Next i

    Application.ScreenUpdating = True
End Sub

Before:

After:

Answer 4

I found this on ozgrid and made a little function out of it:

Option Explicit

Function DoesNamedRangeExist(VarS_Name As String) As Boolean
Dim NameRng As Name

For Each NameRng In ActiveWorkbook.Names
    If NameRng.Name = VarS_Name Then
        DoesNamedRangeExist = True
        Exit Function
    End If
Next NameRng

DoesNamedRangeExist = False
End Function

You can put this line in your code to check:

DoesNamedRangeExist("Monday1")

It will return a Boolean value (True / False) so it's easy to use with an IF() statement

As to your question on merged cells, I did a quick macro record on a 2*2 merged cell and it gave me this (made smaller and added comments):

Sub Macro1()
    Range("D2:E3").Copy 'Orignal Merged Cell
    Range("G2").PasteSpecial xlPasteAll 'Top left of destination
End Sub