Solved

Determine if cell has defined name or not

Posted on 2010-11-25
7
717 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
Comment Utility
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
Comment Utility
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 68

Expert Comment

by:Qlemo
Comment Utility
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
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 
LVL 4

Expert Comment

by:BrainB
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
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 demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

728 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

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now