Solved

Determine if cell has defined name or not

Posted on 2010-11-25
7
736 Views
Last Modified: 2012-05-10
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

0
Comment
Question by:Haydan
7 Comments
 
LVL 23

Expert Comment

by:Michael74
ID: 34214271
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

0
 
LVL 23

Expert Comment

by:Michael74
ID: 34214281
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

0
 
LVL 69

Expert Comment

by:Qlemo
ID: 34214384
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

0
Netscaler Common Configuration How To guides

If you use NetScaler you will want to see these guides. The NetScaler How To Guides show administrators how to get NetScaler up and configured by providing instructions for common scenarios and some not so common ones.

 
LVL 4

Expert Comment

by:BrainB
ID: 34214671
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

0
 
LVL 23

Expert Comment

by:Michael74
ID: 34215711
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

0
 
LVL 23

Accepted Solution

by:
Michael74 earned 125 total points
ID: 34215727
Sorry posted the code above and then noticed a I had missed a full stop in my code

I also noticed that you refered to a sheet purely by its name as in
Set vr = Verification.Range("A:D")

I have changed this to
Set vr = Sheets("Verification")>Range("A:D")
and
Sheets("Verification").Activate
Option Explicit
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 = Sheets("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

Sheets("Verification").Activate

Exit Sub

NoName:
   rCell.Value = DefaultName & DefaultNameNumber
   DefaultNameNumber = DefaultNameNumber + 1
   Resume Next

End Sub

Open in new window

0
 

Author Closing Comment

by:Haydan
ID: 34218813
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 :) ).
0

Featured Post

DevOps Toolchain Recommendations

Read this Gartner Research Note and discover how your IT organization can automate and optimize DevOps processes using a toolchain architecture.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

809 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question