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]