Prompt User for Range Input and then Use in Formula

[rex_411]

I was trying to create a way to replace state abbreviations with full names. I found a great formula for this (below). What I would like is to replace the hard coded range with a prompt to the user for the range ("Select the List State Abbreviations"). I would also like the VBA script to ask the user where the state names should be placed ("Select First Cell for State Names").

Sub ReplaceStateAbbrev()
Const StateNames As String = _
"Alabama,Alaska,Arizona,Arkansas,California,Colorado,Connecticut,Delaware,Florida," & _
"Georgia,Hawaii,Idaho,Illinois,Indiana,Iowa,Kansas,Kentucky,Louisiana,Maine," & _
"Maryland,Massachusetts,Michigan,Mississippi,Missouri,Minnesota,Montana,Nebraska," & _
"Nevada,New Hampshire,New Jersey,New Mexico,New York,North Carolina,North Dakota," & _
"Ohio,Oklahoma,Oregon,Pennsylvania,Rhode Island,South Carolina,South Dakota,Tennessee," & _
"Texas,Utah,Vermont,Virginia,Washington,West Virginia,Wisconsin,Wyoming"
Const StateIds As String = _
"AL,AK,AZ,AR,CA,CO,CT,DE,FL,GA,HI,ID,IL,IN,IA,KS,KY,LA,ME,MD,MA,MI,MS,MO,MN,MT," & _
"NE,NV,NH,NJ,NM,NY,NC,ND,OH,OK,OR,PA,RI,SC,SD,TN,TX,UT,VT,VA,WA,WV,WI,WY"
Dim vecStateNames As Variant
Dim vecStateIds As Variant
Dim cell As Range

vecStateIds = Split(StateIds, ",")
vecStateNames = Split(StateNames, ",")


***Add in Prompt to user for abbreviation range***

For Each cell In Range("R3:R50")

If cell.Value <> "" Then

***Add in Prompt to user for where to place full Names***

cell.Offset(0, 1).Value = Application.Index(vecStateNames, Application.Match(cell.Value, vecStateIds, 0))
End If
Next cell
End Sub

 

[tonyyy]

You might give this a try...

Sub ReplaceStateAbbrev()
Const StateNames As String = _
      "Alabama,Alaska,Arizona,Arkansas,California,Colorado,Connecticut,Delaware,Florida," & _
      "Georgia,Hawaii,Idaho,Illinois,Indiana,Iowa,Kansas,Kentucky,Louisiana,Maine," & _
      "Maryland,Massachusetts,Michigan,Mississippi,Missouri,Minnesota,Montana,Nebraska," & _
      "Nevada,New Hampshire,New Jersey,New Mexico,New York,North Carolina,North Dakota," & _
      "Ohio,Oklahoma,Oregon,Pennsylvania,Rhode Island,South Carolina,South Dakota,Tennessee," & _
      "Texas,Utah,Vermont,Virginia,Washington,West Virginia,Wisconsin,Wyoming"
Const StateIds As String = _
      "AL,AK,AZ,AR,CA,CO,CT,DE,FL,GA,HI,ID,IL,IN,IA,KS,KY,LA,ME,MD,MA,MI,MS,MO,MN,MT," & _
      "NE,NV,NH,NJ,NM,NY,NC,ND,OH,OK,OR,PA,RI,SC,SD,TN,TX,UT,VT,VA,WA,WV,WI,WY"
Dim vecStateNames As Variant
Dim vecStateIds As Variant
Dim ChosenNames As Variant
Dim IDs As Range
Dim Names As Range
Dim i As Long

vecStateIds = Split(StateIds, ",")
vecStateNames = Split(StateNames, ",")

Set IDs = Application.InputBox(prompt:="Select the List State Abbreviations", Type:=8)
IDs.Select
ReDim ChosenNames(1 To Selection.Rows.Count)
For i = LBound(ChosenNames) To UBound(ChosenNames)
    ChosenNames(i) = Application.Index(vecStateNames, Application.Match(Selection(i).Value, vecStateIds, 0))
Next i

Set Names = Application.InputBox(prompt:="Select First Cell for State Names", Type:=8)
Range(Names, Cells(Names.Row + UBound(ChosenNames) - 1, Names.Column)).Value = WorksheetFunction.Transpose(ChosenNames)
End Sub

Cheers,

tonyyy

 

[rex_411]

tonyyy,
Works Brilliantly. I hope your changes make it as easy for the next guy as they have for me.

 

[tonyyy]

Glad it worked out, rex_411.