Let the user click on the cells as their input for an Excel InputBox using VBA

Question

I have an InputBox that stores user input into a variable. The input the user is inputting is a cell number.

For example, the input box pops up and asks the user, "Where would you like to start?" The user would then type in A4, or whichever cell they would want to start.

My question is, is there a way to allow the user to physically click on cell A4 instead of typing it in?

Thanks in advance for any help

Update: So, basically we have long lists of transposed data that span horizontally. We want those lists to stacked on top of each other horizontally, which is what this code is supposed to do.

Everything worked fine before, but the user would to have to manually type in the cell number into the InputBox. The input box asks the user where they want to start cutting and the second box asks the user where they want to start pasting. I would store those input values into string variables and everything worked like a charm.

Since then, I wanted the user to be able to physically click on the cell since it can be difficult to look at which row number it actually is. The code below is updated to reflect the changes trying to be used to allow the user to click on the cell. I added the Application.InputBox method and changed my declarations of the variables to Range.

I stepped into the program one at a time to see what was going on and this is what I found. Before, if the User wanted to start at B4 and paste to A16, it would select the data range for B(B4:B15), cut it, and paste it to A16. Then, the way I had the code, it would go back to the B4 user input spot and using a for loop to increment my x variable, it would offset to the next column over to the right. So, it would then repeat the process of cutting column C(C4:C15) and paste it this time to A28(using xldown), and so on for proceeding columns.

What is happening now when I stepped into this current code is that I don't see any recorded values into my Range variables. It does the first step of cutting B4:B15 and pasting it to A16, but when it goes to run the next loop, instead of starting back at B4 and offsetting, it starts off on A16 and then offsets. It should be going back to B4, which the user selected as the starting spot, and then offsetting.

Sorry, for the long explanations, but I hope this helped to clear the situation up.

Current code using Application.InputBox

 Dim x As Integer
 Dim strColumnStart As Range
 Dim strColumnEnd As Range

 On Error Resume Next

 Application.DisplayAlerts = False

 Set strColumnStart = Application.InputBox("What cell would you like to start at?", "Starting position","Please include column letter and  cell number", Type:=8)

 On Error GoTo 0

 Set strColumnEnd = Application.InputBox("Where would you like to paste the cells to?", "Pasting position", "Please include column letter and cell number", Type:=8)

 On Error GoTo 0

 Application.DisplayAlerts = True

 If strColumnStart = "What cell would you like to start at?" Or _
 strColumnEnd = "Please include column letter and cell number" Then

    Exit Sub

 Else

 For x = 0 To strColumnStart.CurrentRegion.Columns.Count 
   strColumnStart.Select 
   ActiveCell.Offset(0, x).Select 

   If ActiveCell.Value = Empty Then 
      GoTo Message 
   Else 
      Range(Selection, Selection.End(xlDown)).Select 
      Selection.Cut strColumnEnd.Select 
      ActiveCell.Offset(-2, 0).Select 
      ActiveCell.End(xlDown).Select 
      ActiveCell.Offset(1, 0).Select 
      ActiveSheet.Paste 
      strColumnStart.Select 
   End If 
   Next x

   End If

 Message:
 MsgBox ("Finished")
 strColumnEnd.Select
 ActiveSheet.Columns(ActiveCell.Column).EntireColumn.AutoFit
 Application.CutCopyMode = False
End Sub

Tim Williams Tim Williams · Accepted Answer · 2011-09-08T20:20:07

From: http://www.ozgrid.com/VBA/inputbox.htm

Sub RangeDataType()

    Dim rRange As Range

    On Error Resume Next

        Application.DisplayAlerts = False

            Set rRange = Application.InputBox(Prompt:= _
                "Please select a range with your Mouse to be bolded.", _
                    Title:="SPECIFY RANGE", Type:=8)

    On Error GoTo 0

        Application.DisplayAlerts = True

        If rRange Is Nothing Then
           Exit Sub
        Else
          rRange.Font.Bold = True
        End If
End Sub

Updated with OP's requirements:

Sub Test2()

     Dim x As Integer
     Dim rngColumnStart As Range
     Dim rngColumnEnd As Range
     Dim rngCopy As Range
     Dim numRows As Long, numCols As Long


     On Error Resume Next
     Set rngColumnStart = Application.InputBox( _
            "Select the cell you'd like to start at", _
            "Select starting position", , Type:=8)

     If rngColumnStart Is Nothing Then Exit Sub

     Set rngColumnEnd = Application.InputBox( _
             "Select where you'd like to paste the cells to", _
             "Select Pasting position", , Type:=8)

     On Error GoTo 0

     If rngColumnEnd Is Nothing Then Exit Sub

     Set rngColumnEnd = rngColumnEnd.Cells(1) 'in case >1 cell was selected

     Set rngCopy = rngColumnStart.CurrentRegion
     numRows = rngCopy.Rows.Count
     numCols = rngCopy.Columns.Count

     For x = 1 To numCols
       rngCopy.Columns(x).Copy _
                rngColumnEnd.Offset((x - 1) * numRows, 0)
     Next x

     rngCopy.ClearContents

     MsgBox ("Finished")
     rngColumnEnd.EntireColumn.AutoFit
     Application.CutCopyMode = False

End Sub

Let the user click on the cells as their input for an Excel InputBox using VBA

1 Answers