Assumptions:

1. Column A contains text; Column B contains values
2. User will select a gapless range within Column A and only Column A

Upon running, I would like to apply the text of each cell within the selected range to the adjacent Column B cell as a Named Range.

(A1 = Tom; B1 = 1,300,000; Named Range for B1 becomes "Tom"; repeat through end of selection)

My effort below. I suppose I need help setting the selected range boundaries and likely developing the loop:

Sub ApplyAdjacentName()

Dim rngCell As Range
Dim rngSource As Range
Dim strName As String

'Need help here
Set rngSource = Selection.Rows.count

   For Each rngCell In rngSource
      strName = CStr(rngCell.Value)
      ActiveWorkbook.Names.Add Name:=strName, RefersToR1C1:=rngCell.Offset(0, 1)
   Next rngCell

End Sub
Thanks!