Solved: Auto-Name a Range

I'd like to select some cells, and hit a button, and have it automatically name the range using the value in the cell just above the top-most cell selected. If the named range already exists, that's okay, I'd like it overwritten.

So, if I select G18:G28 and hit the button, I want it to use the value in G17 for the name of the range. It will never have spaces in it, if that matters.

:)

This would make a GREAT KB entry, too!

Try this macro.

[vba]
Option Explicit

Sub NamedRange()

Dim RangeName As String
Dim TargetRange As Range

On Error Resume Next
Set TargetRange = Selection
On Error GoTo 0
If Not TargetRange Is Nothing Then
RangeName = TargetRange(1, 1).Offset(-1, 0).Text
On Error Resume Next
ActiveWorkbook.Names.Add Name:=RangeName, RefersTo:=TargetRange
If Err.Number = 0 Then
MsgBox "The Named Range " & RangeName & _
" has been created.", vbInformation, "Range Added"
Else
MsgBox "The Named Range could not be created", vbCritical, "Range Not Added"
End If
On Error GoTo 0
End If

End Sub
[/vba]

Thank you thank you thank you!!

As you can imagine, it's that SAME DAMN workbook!! Did you notice that all his data validation lists were repeated on any sheet on which he used it? (He didn't use named ranges) BLAH!!! So... so much to do manually in his workbook. I did send it tonight, so payday should be soon. :)

Glad to help. Yeah, that workbook was a mess.

:beerchug:

Here is an alternative solution using built-in functionality.

[VBA]
Sub AutoNameCreate()

If Selection(1, 1).Row <> 1 Then
Selection.Offset(-1, 0).Resize(Selection.Rows.Count + 1).CreateNames _
Top:=True
End If
End Sub[/VBA]

Interestingly, when I tested this, Jake's method failed for me. I haven't tested extensively but it seems that approach doesn't like embedded spaces in the cell to get the name from, wereas CreateNames substitutes an underscore. I need to test this some more, I wasn't aware of this.

Quote:

---

Originally Posted by Dreamboat

Did you notice that all his data validation lists were repeated on any sheet on which he used it? (He didn't use named ranges)

---

There has been a thread here suggesting that no more than one Excel name should be used!

Right, xld. I have deleted all named ranges that were sheet-specific. Apparently, ranges were copied, which brought over the named ranges. Then the "new" named range was deleted, which resulted in #REFs. I've created a DataSheet, where I've placed ALL the dropdown validation values. And at this rate, I am still probably only 10% into completely fixing this workbook. I'll put your macro in the workbook itself for the user to use later. Thanks!

Quote:

---

Originally Posted by Dreamboat

And at this rate, I am still probably only 10% into completely fixing this workbook. I'll put your macro in the workbook itself for the user to use later.

---

Want any help?

Thanks, no. It's boring and tedious and lots of manual work. As I do it, I'm learning the workbook, using little macros here and there to help me out.

Actually... I could use a macro that finds in original.xls, which is open, all cell formats that have decimal and comma formats, and also percent formats, and copy the format over to its corresponding cell in annetemplate4.xls, which is exactly the same, but has two sheets added. What a pain! I have this code, but it must not have worked right:

[vba]Sub CopyFormats()
'Copy all formats from one workbook to another
'Requires sheets to be indentical in each workbook
Dim wbOriginal As Workbook
Dim wbTarget As Workbook
Dim ws As Worksheet
Dim cl As Range
Dim testrange As Range
'Set workbook names here
Set wbOriginal = Workbooks("original.xls")
Set wbTarget = Workbooks("annetemplate4.xls")
'Turn off screen updates for speed
Application.ScreenUpdating = False
'Loop through each sheet copying formulas to target workbook
For Each ws In wbOriginal.Worksheets
Application.StatusBar = "Processing worksheet: " & ws.Name
For Each cl In ws.UsedRange
If cl.FormatConditions.Count > 0 Then
Debug.Print ws.Name & "!" & cl.Address
cl.Copy
wbTarget.Worksheets(ws.Name).Range(cl.Address).PasteSpecial Paste:=xlFormats
End If
Next cl
Next ws
'Resume screen updates and clear statusbar
With Application
.ScreenUpdating = False
.StatusBar = False
End With
End Sub
[/vba]

Your code is looking at conditional formats, but your text says normal form ats. Assuming the text is correct, isn't it as simple as

[VBA]
Sub CopyFormats()
'Copy all formats from one workbook to another
'Requires sheets to be indentical in each workbook
Dim wbOriginal As Workbook
Dim wbTarget As Workbook
Dim ws As Worksheet
Dim cl As Range
Dim testrange As Range
'Set workbook names here
Set wbOriginal = Workbooks("originals.xls")
Set wbTarget = Workbooks("annetemplate4.xls")
'Turn off screen updates for speed
Application.ScreenUpdating = False
'Loop through each sheet copying formulas to target workbook
For Each ws In wbOriginal.Worksheets
ws.Cells.Copy
wbTarget.Activate
Worksheets(ws.Name).Activate
Cells.PasteSpecial Paste:=xlFormats
Next ws
'Resume screen updates and clear statusbar
With Application
.ScreenUpdating = False
.StatusBar = False
End With
End Sub
[/VBA]