Worksheet-level names

Dear Experts:

below macro ...
... searches for the string 'Sales' and creates ranges for the respective 'Current Region'

I would like the macro to create ranges with a worksheet level scope (local), not a workbook-level scope (global).

How does the code have to be re-written?

Help is much appreciated. Thank you very much in advance.

I have attached a sample file with the code for your convenience.

Regards, Andreas

 Create-Named-Ranges.xls
Andreas HermleTeam leaderAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rory ArchibaldCommented:
Try this:
Sub Ranges_Create()
    Dim c As Range
    Dim firstAddress As String, strSheet As String
    Dim i As Long
i = 1
strSheet = "'" & ActiveSheet.Name & "'!"
With Range("A1")
If .Value = "Sales" Then
    .CurrentRegion.Name = strSheet & "range" & i
    firstAddress = .Address
    i = i + 1
End If
End With


Set c = Cells.Find(What:="Sales", After:=Range("A1"), _
            LookIn:=xlValues, LookAt:=xlPart, _
            SearchOrder:=xlByColumns, _
            SearchDirection:=xlNext, _
            MatchCase:=True)


    Do While Not c Is Nothing And c.Address <> firstAddress
        c.CurrentRegion.Name = strSheet & "range" & i
        i = i + 1
        If firstAddress = "" Then firstAddress = c.Address
        Set c = Cells.FindNext(c)
    Loop

Call RenamingNames

End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Andreas HermleTeam leaderAuthor Commented:
Hi rorya,

great job. Works like a charm. Thank you very much for your superb support.

There is one more thing where you may be able to help me out.  

The macro 'RenamingNames' which is called at the end of the above procedure (see attached file where this macro is stored) is supposed to rename the ranges named 'range1 to range9' to range01 ... range09'.  This macro works fine with workbook level names but it regrettably does not work anymore with worksheet level names.

Is it possible for  you to re-write this code, too?

I could also close and rate this question first and then post a follow-up question, if you want.

Regards, Andreas
Sub RenamingNames()
Dim rng As Name
Dim str As String

    For Each rng In ActiveWorkbook.Names
        str = Replace(rng.Name, "range", "", , , vbTextCompare)
        Debug.Print rng.Name
        If IsNumeric(str) Then
            If str >= 1 And str <= 9 Then _
                rng.Name = Replace(rng.Name, str, Format(str, "00"))
        End If
        Debug.Print rng.Name
    Next

End Sub

Open in new window

0
Rory ArchibaldCommented:
First question: why not just name them properly in the first place?
0
Bootstrap 4: Exploring New Features

Learn how to use and navigate the new features included in Bootstrap 4, the most popular HTML, CSS, and JavaScript framework for developing responsive, mobile-first websites.

Andreas HermleTeam leaderAuthor Commented:
Hi rorya:

good question, I have to admit, but I would if I could.

Regards, Andreas
0
Rory ArchibaldCommented:
But you original code creates the names, so why not format the number part then instead of afterwards?
0
Andreas HermleTeam leaderAuthor Commented:
Hi rorya,

ok, I got what you mean. I guess I will be able to achieve it.

Thank you very much.

Regards, Andreas
0
Andreas HermleTeam leaderAuthor Commented:
Great job, rorya. Thank you very much.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.