asked on

Determine if cell has defined name or not

This is pretty simple stuff I want to check if the cell has a defined name or not, if it has a name I want it to be filled with that name if not I want to give that cell a generic name, can't work out how to do the check though...

If IsError(rCell.Name.Name) = False Then
rCell.Value = rCell.Name.Name
Else
rCell = DefaultName & DefaultNameValue
DefaultNameValue = DefaultNameValue + 1
End If

Private Sub CommandButton1_Click()
'This Code adds verification to a color coded book.

    Dim rCell As Range
    Dim N As Single
    Dim vr As Range
    Dim i As Long
    Dim NowCount As String
    Dim aColor As Long ' Data entry for random number (Light Blue)
    Dim bColor As Long ' Data entry for words - set by cell defined name (Very Pale Blue)
    Dim cColor As Long ' Verification data that shouldn't be changed but should be removed prior to issue (Tan)
    Dim dColor As Long ' Data/Formulas that shouldn't be changed or removed prior to issue (Very Pale Green)
    Dim DefaultName As String
    Dim DefaultNameValue As Integer
    Randomize ' Initiate random number generator
    aColor = RGB(153, 204, 255) 'Specify the color range for random numbers
    bColor = RGB(204, 255, 255)
    cColor = RGB(255, 204, 153)
    dColor = RGB(204, 255, 204)
    DefaultName = "CellNeedsName"
    DefaultNameNumber = 1
    
'Add the random numbers

For N = 1 To Sheets.count
    For Each rCell In Sheets(N).UsedRange
        If rCell.Interior.Color = aColor Then
        rCell.Value = 0.6 + (0.3 * Rnd)
        Else
        End If
    Next rCell
Next N

'Add the cell names

For N = 1 To Sheets.count
    For Each rCell In Sheets(N).UsedRange
        If rCell.Interior.Color = bColor Then
            If IsError(rCell.Name.Name) = False Then
                rCell.Value = rCell.Name.Name
            Else
                rCell = DefaultName & DefaultNameValue
                DefaultNameValue = DefaultNameValue + 1
            End If
        Else
        End If
    Next rCell
Next N

'Sets up verification sheet
i = 2
Set vr = Verification.Range("A:D")
For N = 1 To Sheets.count
NowCount = ""
    If Sheets(N).Name = "Verification" Then
    Else
        i = i + 1
        Sheets(N).Activate
        vr.Cells(i, 1).Value = Sheets(N).Name
    For Each rCell In Sheets(N).Cells.SpecialCells(xlCellTypeFormulas) 'looks for NOW formula and removes them from the equation
        If rCell.Formula = "=NOW()" Then NowCount = NowCount & "-Sum('" & ActiveSheet.Name & "'!" & rCell.Address(0, 0) & ")"
    Next
        vr.Cells(i, 2).Value = "=Sum('" & ActiveSheet.Name & "'!" & ActiveSheet.UsedRange.Address(0, 0) & ")" & NowCount
 '       vr.Cells(i, 3).Value = NowCount
        vr.Cells(i, 4).Value = vr.Cells(i, 2).Value
    End If
Next N
'ActiveCell.FormulaR1C1

Verification.Activate

End Sub

Open in new window

Michael Fowler

You use the error handling to do this

Sub test()

Dim r As Range

On Error GoTo NoName
Set r = Range("A")
Exit Sub
On Error GoTo 0

NoName:
   Range("A1").Name = "Generic"
   Resume Next

End Sub

Open in new window

Michael Fowler

Oops code out of order

Sub test()

Dim r As Range

On Error GoTo NoName
Set r = Range("A")
On Error GoTo 0
Exit Sub


NoName:
   Range("A1").Name = "Generic"
   Resume Next

End Sub

Open in new window

Qlemo

That one seems correct. The above still contains errors:

Sub test()
Dim n As String
  On Error Resume Next
  n = Range("A1").Name
  On Error GoTo 0
  If n = "" Then Range("A1").Name = "Duff"
End Sub

Open in new window

BrainB

This is a bit more complicated than it seems at first look.
However I think this does the job Ok.
Need to set the range you want to search and the default name - then run the macro.

'=============================================================================
'- ADD RANGE NAMES TO CELLS NOT ALREADY NAMED
'- Adds the new name at Workbook level. Inserts range name into the cell
'----------------------------------------------------------------------------
'- ** NEED TO SET ........
'- 1. 'MainRange' variable to range required to search ****
'- 2. The default name you wish to use (currently "Default")
'---------------------------------------------------------------------------
'- NB. If the macro is run more than once the default name/number might exist
'-     so there is a subroutine to check first to get the next sequence number
'-     Checks WorkBook level and WorkSheet level names.
'- Brian Baulsom November 2010
'=============================================================================
Dim MyMainRange As Range
Dim MyCell As Range
Dim MyName As String
Dim MyAddress As String
Dim DefaultName As String
Dim DefaultNameValue As Integer
Dim AddCounter As Integer

'=============================================================================
'- MAIN ROUTINE
'=============================================================================
Sub CHECK_RANGE_NAMES()
    '*************************************************************************
    '- SETTINGS : RANGE TO SEARCH & DEFAULT NAME
    Set MyMainRange = ActiveSheet.Range("A1:A10") '****************************
    DefaultName = "Default"                       '*****************************
    '*************************************************************************
    Application.Calculation = xlCalculationManual
    DefaultNameValue = 1
    AddCounter = 0
    '=======================
    CHECK_LAST_DEFAULT          ' SUBROUTINE
    '=======================
    MsgBox ("Next Default Name : =  " & DefaultName & DefaultNameValue)
    '-------------------------------------------------------------------------
    '- loop
    On Error Resume Next
    For Each MyCell In MyMainRange
        MyName = ""
        MyName = MyCell.Name.Name  ' does not change if there is an 'error'
        '---------------------------------------------------------------------
        '- GET NAME
        If MyName = "" Then
            '-----------------------------------------------------------------
            '- NEW NAME
            MyName = DefaultName & CStr(DefaultNameValue)
            MyAddress = "='" & ActiveSheet.Name & "'!" & MyCell.Address
            ActiveWorkbook.Names.Add _
                Name:=MyName, _
                RefersTo:=MyAddress
            DefaultNameValue = DefaultNameValue + 1
            MyCell.Value = MyName
            AddCounter = AddCounter + 1
            '-----------------------------------------------------------------
        Else
            '-----------------------------------------------------------------
            '- EXISTING NAME : REMOVE WORKSHEET NAME FOR DISPLAY
            c = InStr(1, MyName, "!", vbTextCompare)
            MyCell.Value = Right(MyName, Len(MyName) - c)
            '-----------------------------------------------------------------
        End If
    Next
    '-------------------------------------------------------------------------
    MsgBox ("Done" & vbCr & "Added " & AddCounter & " name(s).")
    Application.Calculation = xlCalculationAutomatic
End Sub
'=============================================================================

'=============================================================================
'- SUBROUTINE TO CHECK LAST DEFAULT NUMBER
'- Range names can be at Workbook or Worksheet level - so checks both
'=============================================================================
Private Sub CHECK_LAST_DEFAULT()
    Dim n As Integer, c As Integer
    '-------------------------------------------------------------------------
    '- CHECK WORKSHEET NAMES
    For Each Name In ActiveSheet.Names
        MyName = Name.Name
        c = InStr(1, MyName, DefaultName, vbTextCompare)
        If c > 0 Then
            n = CInt(Right(MyName, Len(MyName) - Len(DefaultName)))
            If n > DefaultNameValue Then DefaultNameValue = n
        End If
    Next
    '-------------------------------------------------------------------------
    '- CHECK WORKBOOK NAMES
    For Each Name In ActiveWorkbook.Names
        MyName = Name.Name
        c = InStr(1, MyName, DefaultName, vbTextCompare)
        If c > 0 Then
            n = CInt(Right(MyName, Len(MyName) - Len(DefaultName)))
            If n > DefaultNameValue Then DefaultNameValue = n
        End If
    Next
    '-------------------------------------------------------------------------
    DefaultNameValue = DefaultNameValue + 1 ' next number
End Sub
'=========== end of subroutine ===============================================

Open in new window

Michael Fowler

Here you go, I have placed my example above into your code

Private Sub CommandButton1_Click()
'This Code adds verification to a color coded book.

    Dim rCell As Range
    Dim N As Single
    Dim vr As Range
    Dim i As Long
    Dim NowCount As String
    Dim aColor As Long ' Data entry for random number (Light Blue)
    Dim bColor As Long ' Data entry for words - set by cell defined name (Very Pale Blue)
    Dim cColor As Long ' Verification data that shouldn't be changed but should be removed prior to issue (Tan)
    Dim dColor As Long ' Data/Formulas that shouldn't be changed or removed prior to issue (Very Pale Green)
    Dim DefaultName As String
    Dim DefaultNameNumber As Integer
    Randomize ' Initiate random number generator
    aColor = RGB(153, 204, 255) 'Specify the color range for random numbers
    bColor = RGB(204, 255, 255)
    cColor = RGB(255, 204, 153)
    dColor = RGB(204, 255, 204)
    DefaultName = "CellNeedsName"
    DefaultNameNumber = 1
    
'Add the random numbers

For N = 1 To Sheets.Count
    For Each rCell In Sheets(N).UsedRange
        If rCell.Interior.Color = aColor Then
        rCell.Value = 0.6 + (0.3 * Rnd)
        Else
        End If
    Next rCell
Next N

'Add the cell names

For N = 1 To Sheets.Count
    For Each rCell In Sheets(N).UsedRange
        If rCell.Interior.Color = bColor Then
            On Error GoTo NoName
            rCell.Value = rCell.Name.Name
            On Error GoTo 0
        End If
    Next rCell
Next N

'Sets up verification sheet
i = 2
Set vr = Verification.Range("A:D")
For N = 1 To Sheets.Count
NowCount = ""
    If Sheets(N).Name = "Verification" Then
    Else
        i = i + 1
        Sheets(N).Activate
        vr.Cells(i, 1).Value = Sheets(N).Name
    For Each rCell In Sheets(N).Cells.SpecialCells(xlCellTypeFormulas) 'looks for NOW formula and removes them from the equation
        If rCell.Formula = "=NOW()" Then NowCount = NowCount & "-Sum('" & ActiveSheet.Name & "'!" & rCell.Address(0, 0) & ")"
    Next
        vr.Cells(i, 2).Value = "=Sum('" & ActiveSheet.Name & "'!" & ActiveSheet.UsedRange.Address(0, 0) & ")" & NowCount
 '       vr.Cells(i, 3).Value = NowCount
        vr.Cells(i, 4).Value = vr.Cells(i, 2).Value
    End If
Next N
'ActiveCell.FormulaR1C1

Verification.Activate

Exit Sub

NoName:
   rCellvalue = DefaultName & DefaultNameNumber
   DefaultNameNumber = DefaultNameNumber + 1
   Resume Next

End Sub

Open in new window

ASKER CERTIFIED SOLUTION

Michael Fowler

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Haydan

ASKER

Thanks mate that was a bit above and beyond.

All sheets have defined names so refering to it as Verification works fine and allows me to rename sheets without having to alter the VBA. I decided on Michaels as its a little simpler than Brians (I shouldn't say that I hate it when people say I make complicated things - what I really mean is I don't fully understand Brians :) ).