Create Button That Prompts User To Select Active Cell

[eulerddx4]

Hello,
I have a macro that uses the active cell to sort through data and fill the acceptable data into three new columns. I wanted to see if someone could help me create a button that prompts the user to select the active cell and then runs through my macro code. This would be very helpful in improving the functionality of my spreadsheet. I'm thinking of using a Msgbox to say something like Please pick the cell you would like to begin sorting. Then the user would be able to click the active cell and the macro would run. Could someone help me write this? I know very little about writing macros and could use your help. Here is my existing code:



Sub mypicker()
rownow=activecell.row
columnnow=activecolumn.column
newrow=9
newcolumn=1
mytime=0
While Cells(rownow,columnnow).Value <> ""
If Cells (rownow,columnnow).Value >18 or (rownow,columnnow).Value <=0 Then
mya=myb
Else
Cells(newrow,newcolumn).Value = mytime
Cells(newrow,newcolumn+1).Value = Cells(rownow,columnnow-1).Value
Cells(newrow,newcolumn+4).Value = Cells(rownow,column now).Value
newrow=newrow+1
End If
rownow=rownow+1
mytime=mytime+1
Wend
End Sub

 

[iliace]

Something like this:

Sub mypicker()
  Dim rng As Variant

  rng = Application.InputBox("Select Active Cell", Type:=8)
  if rng = False Then Exit Sub ' if cancel is clicked, stop


  rownow = rng.row
  columnnow = rng.column
  newrow=9
  newcolumn=1
  mytime=0
  While Cells(rownow,columnnow).Value <> ""
    If Cells (rownow,columnnow).Value >18 or (rownow,columnnow).Value <=0 Then 
       mya=myb
    Else
      Cells(newrow,newcolumn).Value = mytime
      Cells(newrow,newcolumn+1).Value = Cells(rownow,columnnow-1).Value
      Cells(newrow,newcolumn+4).Value = Cells(rownow,column now).Value
      newrow=newrow+1
    End If
    rownow=rownow+1
    mytime=mytime+1
  Wend
End Sub

 

[eulerddx4]

Hi, thanks for your help. For some reason when I add this code I am able to select the cell that I want to start filtering but then I get runtime error 424.

 

[eulerddx4]

The code, modified as suggested is:


Sub mypicker()
Dim rng As Variant
rng = Application.InputBox("Select the first velocity data point that you would like to filter", Type:=8)
If rng = False Then Exit Sub
rownow = rng.Row
columnnow = rng.Column
newrow = 9
newcolumn = 1
mytime = 0
While Cells(rownow, columnnow).Value <> ""
If Cells(rownow, columnnow).Value > 18 Or Cells(rownow, columnnow).Value <= 0 Or Abs(Cells(rownow + 1, columnnow - 1) - Cells(rownow, columnnow - 1)) > 0.2 Then
mya = myb
Else
Cells(newrow, newcolumn).Value = mytime
Cells(newrow, newcolumn + 1).Value = Cells(rownow, columnnow - 1).Value
Cells(newrow, newcolumn + 4).Value = Cells(rownow, columnnow).Value
newrow = newrow + 1
End If
rownow = rownow + 1
mytime = mytime + 1
Wend
End Sub