Copy and paste the Range address displayed in the Msg Box below subroutine to any selected cell

[shoun2502]

I have a following code which displays the Range address in the msg box after executing the code

I am looking to copy and paste Range address to any of the Selected cell.

Sub GetRangeAddress()
Dim r As Range
Dim s As String

  Select Case Selection.Areas.Count
  Case 0:
    MsgBox "Nothing selected."
  Case 1:
    MsgBox "Selected range: " & Selection.Areas(1).Address(False, False)
  Case Else
    s = ""
    For Each r In Selection.Areas
      s = s + vbNewLine + r.Address(False, False)
    Next r
    MsgBox "Selected several areas:" & s
  End Select
End Sub

I would appreciate if any one could help to customize the code and get the desired result.

Thanks in anticipation

 

[gallen]

You don't specify which cells need to contain the address

This puts it in the first cell of the selection:

Sub GetRangeAddress()
Dim r As Range
Dim s As String

  Select Case Selection.Areas.Count
  Case 0:
    MsgBox "Nothing selected."
  Case 1:
    MsgBox "Selected range: " & Selection.Areas(1).Address(False, False)
    Selection.Cells(1, 1) = Selection.Areas(1).Address(False, False)
  Case Else
    s = ""
    For Each r In Selection.Areas
      s = s + vbNewLine + r.Address(False, False)
    Next r
    MsgBox "Selected several areas:" & s
    Selection.Cells(1, 1) = s
  End Select
End Sub

 

[shoun2502]

Hi gallen ,

It will not suffice my purpose. As it replaces my value of the selection with the Range address and subsequently will change my data.

If its possible to change it A1 would be fine with me.

Thanks

 

[gallen]

So just replace both instances of:

Selection.Cells(1, 1)

with

Range("A1")