• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA - Use Application.InputBox to Select Range/Column Input by User

APM

New Member
Hello,

I have been trying to figure out how to use the Application.InputBox to let the user select the range or whole column where the targeted data is.
My main goal is to have automated the conversion from US state name to US state abbreviation based on the selected column by the user. As of right now, I have the conversion part of the code with the range selected as Range("A2:A2000") but I need to change it manually each time, and it is not a really efficient process.
In advance, thanks for any help and for your time. It would be a great learning experience. Feel free to reach out if I haven't explained myself well. Thanks!

'State Cleaning Automation -> State Name to State Abbreviation

>>> use code - tags <<<
Code:
Sub GetStateNames()
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,District of Columbia,Puerto Rico"

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,DC,PR"

Dim vecStateNames As Variant
Dim vecStateIds As Variant
Dim cell As Range

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

For i = LBound(vecStateNames) To UBound(vecStateNames)

    'User Input Box Range("XX:XXXX")
   
    Range("A2:A2000").Replace vecStateNames(i), vecStateIds(i)

Next

End Sub
 

Attachments

  • US State Name.png
    US State Name.png
    33.6 KB · Views: 10
Last edited by a moderator:
Hi,​

first do not forget to use the code tags via the 3 dots icon …​
If it's always the column K so it could be better to directly modify it rather than working with the Selection ?​
Another idea is to use a worksheet 'Settings' with a table of state names & ids​
in order to perform some Excel basics like VLookup, needing a single codeline, more efficient than looping !​
Of course according to forum rules with an attachment of before & after data samples some VBA demonstrations could be shared …​
 
Hi -

I will make sure to use the code tags via the 3 dots icon in the future.

It is not always going to be in column K. I could be in any column, this is the reason why I would like to find a way to select the appropriate column in any data set. Is there anything that could be added to the code I provided above to give the user the possibility to select the column? For example, make the Range("A2:A2000") dynamic based on mouse selection by the user. I hope it makes sense. Thanks.
 
If the user selects the cells just before to launch the VBA procedure so as I wrote you can use directly Selection statement …​
If you want the selection done with the InputBox method just see the well documented VBA help or examples within this forum.​
 
Hi Marc,

I am not sure how to make it work with the Selection statement. Regarding the InputBox, I haven't seen anything that could that help me out in my case. Thanks anyway.
 
Last edited:
As VBA help works only for good enough readers ! …​
As written in VBA help Selection is what is selected within the worksheet like a range for example​
so it can replace the Range statement within your code …​
 
As you can see in VBA help the example well fitting your need and​
as written in forum rules like in post #2 better than any image a workbook attachment may faciliate to help you ‼​
Sample : MsgBox Selection.Address … Read again post #6 !​
 
Marc,

I sincerely apologize. I understand now what you mean. Long day, anyway. Please find attached my workbook. Thanks for helping me out!
 

Attachments

  • State Automation.xlsm
    57.8 KB · Views: 4
According to your attachment explain what the user does, what is the expected result and where it must be …​
 
As a user, I open the workbook, locates the Billing State/Province column, and change manually one by one the state name into the state abbreviation. It takes time and it is not efficient. The Billing/State Province column location in the worksheet can be different depending on the workbook sometimes in column B or G or C, etc.
The end goal would be to have the user run the macro, have an InputBox showing up where he can select the column where the Billing State/Province data is then the code will change the state name to the state abbreviation within the same column (see file attached)
The Billing State/Province column header is always the same therefore maybe would it be easier to use the header than an InputBox...
I hope it makes sense. Thanks Marc!
 

Attachments

  • State Automation Explained.xlsm
    95.6 KB · Views: 5
Yes, just warming a couple of neurons working with the header - so w/o selecting anything - is the smart way​
like using Excel basics (efficient worksheet functions) rather than looping !​
According to your attachment a demonstration as a starter :​
Code:
Sub Demo1()
        Const F = "IF(#>"""",#,"""")"
    With Sheet1.UsedRange
            C = Application.Match("*State*", .Rows(1), 0):  If IsError(C) Then Beep: Exit Sub
            V = Split("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,District of Columbia,Puerto Rico", ",")
            W = Split("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,DC,PR", ",")
            V = Application.Index(Array(V, W), 0, 0)
        With .Columns(C)
             .Value2 = Application.IfError(Application.HLookup(.Value2, V, 2, False), Evaluate(Replace(F, "#", .Address)))
        End With
    End With
End Subb
Do you like it ? So thanks to click on bottom right Like !​
 
  • Like
Reactions: APM
It works great! Thank you so much, Marc!

I have one more thing to ask if possible. Would it be possible to add a keyboard shortcut to execute this macro after the user opens the workbook. Something like Control+Shift+S (S being for State)?
 
First, post #11 code updated with a tiny optimization …​
I guessed the procedure launched via a button …​
Rather than a shortcut the user may just have to double click on the header ?​
 
  • Like
Reactions: APM
I know it can be done much simpler :DD
Code:
Sub GetStateNames()
    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,West Virginia,Virginia,Washington,Wisconsin,Wyoming,District of Columbia,Puerto Rico"

    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,WV,VA,WA,WI,WY,DC,PR"

    Dim vecStateNames As Variant
    Dim vecStateIds As Variant
    Dim Rng         As Range
    Dim LastCell    As Range
    Dim FirstCell   As Range
    Dim rngData     As Range
    Dim vData       As Variant
    Dim oDic        As Object

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

    On Error Resume Next
    Set Rng = Application.InputBox(Prompt:="Specify a range:" & vbLf & _
                                           "(You can select one cell)", _
                                   Default:=ActiveCell.Address, _
                                   Type:=8)

    If Rng Is Nothing Then
        MsgBox "You cancelled", vbExclamation
        Exit Sub
    ElseIf Rng.Columns.Count > 1 Then
        MsgBox "Select range in one column", vbExclamation
        Exit Sub
    ElseIf Rng.Areas.Count > 1 Then
        MsgBox "Select range in one area", vbExclamation
        Exit Sub
    Else
        Set FirstCell = GetCell(ActiveSheet.UsedRange, xlByRows, False)
        Set LastCell = GetCell(ActiveSheet.UsedRange, xlByRows, True)

        If Intersect(Range(FirstCell, LastCell), Rng) Is Nothing Then
            MsgBox "Select cell(s) in the range " & FirstCell.Address(0, 0) & ":" & LastCell.Address(0, 0), _
                   vbExclamation
            Exit Sub
        End If
    End If

    If Rng.Rows.Count > 1 And Rng.Rows.Count < Rows.Count Then
        Set rngData = Rng
    Else
        Set rngData = Intersect(Columns(Rng.Column), Range(FirstCell, LastCell))
    End If


    If MsgBox("Do you want to make changes in the range " & rngData.Address(0, 0) & "?", _
              vbQuestion + vbYesNo) = vbNo Then
        Exit Sub
    End If

    vData = rngData.Resize(, 2).Value

    ReDim Preserve vData(1 To UBound(vData), 1 To 1)

    Set oDic = CreateObject("Scripting.Dictionary")

    For i = LBound(vecStateNames) To UBound(vecStateNames)
        oDic.Add vecStateNames(i), vecStateIds(i)
    Next i

    For i = 1 To UBound(vData)
        If Not IsError(vData(i, 1)) Then
            If oDic.Exists(vData(i, 1)) Then
                vData(i, 1) = oDic(vData(i, 1))
            End If
        End If
    Next i

    rngData.Value = vData

    MsgBox "Ready", vbInformation
End Sub



Function GetCell(InRange As Range, SearchOrder As XlSearchOrder, _
                 Optional isLastCell As Boolean = True, _
                 Optional ProhibitEmptyFormula As Boolean = False) As Range
    ' By Chip Pearson,  www.cpearson.com
    ' modified by Artik

    Dim WS          As Worksheet
    Dim R           As Range
    Dim LastCell    As Range
    Dim LastR       As Range
    Dim LastC       As Range
    Dim SearchRange As Range
    Dim LookIn      As XlFindLookIn
    Dim RR          As Range

    Set WS = InRange.Worksheet

    If ProhibitEmptyFormula = False Then
        LookIn = xlFormulas
    Else
        LookIn = xlValues
    End If

    Select Case SearchOrder
        Case XlSearchOrder.xlByColumns, XlSearchOrder.xlByRows, _
             XlSearchOrder.xlByColumns + XlSearchOrder.xlByRows
            ' OK
        Case Else
            Err.Raise 5
            Exit Function
    End Select

    With WS
        If InRange.Cells.Count = 1 Then
            Set RR = .UsedRange
        Else
            Set RR = InRange
        End If

        Set R = RR(IIf(isLastCell = True, 1, RR.Cells.Count))

        If SearchOrder = xlByColumns Then
            Set LastCell = RR.Find(what:="*", after:=R, LookIn:=LookIn, _
                                   LookAt:=xlPart, SearchOrder:=xlByColumns, _
                                   SearchDirection:=IIf(isLastCell = True, xlPrevious, xlNext), _
                                   MatchCase:=False)
        ElseIf SearchOrder = xlByRows Then
            Set LastCell = RR.Find(what:="*", after:=R, LookIn:=LookIn, _
                                   LookAt:=xlPart, SearchOrder:=xlByRows, _
                                   SearchDirection:=IIf(isLastCell = True, xlPrevious, xlNext), _
                                   MatchCase:=False)
        ElseIf SearchOrder = xlByColumns + xlByRows Then
            Set LastC = RR.Find(what:="*", after:=R, LookIn:=LookIn, _
                                LookAt:=xlPart, SearchOrder:=xlByColumns, _
                                SearchDirection:=IIf(isLastCell = True, xlPrevious, xlNext), _
                                MatchCase:=False)
            Set LastR = RR.Find(what:="*", after:=R, LookIn:=LookIn, _
                                LookAt:=xlPart, SearchOrder:=xlByRows, _
                                SearchDirection:=IIf(isLastCell = True, xlPrevious, xlNext), _
                                MatchCase:=False)
            Set LastCell = Application.Intersect(LastR.EntireRow, LastC.EntireColumn)
        Else
            Err.Raise 5
            Exit Function
        End If
    End With

    Set GetCell = LastCell

End Function

Artik
 
Last edited:
  • Like
Reactions: APM
I know it can be done much simpler
Yes double clicking the header with a few codelines worksheet event just using Excel basics​
so according to the attachment to paste to the Sheet1 (Data Pull) worksheet module :​
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    With Me.UsedRange
            If Intersect(.Rows(1), Target) Is Nothing Then Exit Sub
            Cancel = True
        With .Columns(Target.Column)
             .Value2 = Application.IfError(Application.HLookup(.Value2, Application.Index(Array(Split( _
                        "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,District of Columbia,Puerto Rico", ","), Split( _
                        "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,DC,PR", ",")), _
                        0, 0), 2, False), Evaluate("IF(ISBLANK(" & .Address & "),""""," & .Address & ")"))
        End With
    End With
End Sub
You should Like it !​
 
  • Like
Reactions: APM
Marc L However, I prefer your extended version. The current one is difficult to analyze.

And I wrote my code when APM had not yet changed his mind about the code's operation. So according to the assumptions in the first post.

Artik
 
  • Like
Reactions: APM
Same logic as a beginner worksheet formula when using VLOOKUP on a table for example, whatever the code's operation …​
 
  • Like
Reactions: APM
Artik, according to your code :​
Code:
        Set FirstCell = GetCell(ActiveSheet.UsedRange, xlByRows, False)
        Set LastCell = GetCell(ActiveSheet.UsedRange, xlByRows, True)

        If Intersect(Range(FirstCell, LastCell), Rng) Is Nothing Then
Here FirstCell & LastCell ranges are totally useless - so GetCell function as well - 'cause in your Intersect codeline​
Range(FirstCell, LastCell) is exactly the same as ActiveSheet.UsedRange like you can check yourself via the Address property !​
So these 3 lines can be replaced by this single codeline : If Intersect(ActiveSheet.UsedRange, Rng) Is Nothing Then …​
Another point with the use of the Dictionary object and an array :​
as you may know you can't use it on a Mac Excel version so it can be replaced by a VBA Collection
or here easier with again a single codeline via the worksheet function MATCH which can return an array​
then you can check each element via IsError or IsNumeric VBA functions …​
 
  • Like
Reactions: APM
Back
Top