Adding application.inputbox into offset cut,paste macro

[piguy]

I've put in the following code and it seems to work well. Now I'm wanting to add an input box to tell the user to select a "case" instead of using the cell selected before clicking the button I have assigned to this macro.

Here's the code I have that is working

Sub MoveCase()
'Move Case from one slot to another
Dim rngArea As Range
Set rngArea = Range("d2:d50,s2:s50")    'defined range
If Application.Intersect(rngArea, ActiveCell) Is Nothing Then
    MsgBox ("You did not click a case")
 Else
    ActiveCell.Offset(, -3).Select
    ActiveCell.Resize(, 14).Select
    Selection.Cut
    Range("A20").Select
    Selection.Insert Shift:=xlDown
    MsgBox "The case has been moved"
End If
End Sub

When I try to add the Input Box. I am obviously not even close

Dim ActiveCell As Range
     Set ActiveCell = Application.InputBox(prompt:="Select a case from Column D or S", Type:=8)
    ActiveCell.Offset(0, -3).Select
    ActiveCell.Resize(, 14).Select
    ActiveCell.Cut
    Range("A20").Select
    Selection.Insert Shift:=xlDown
    MsgBox "The case has been moved"

I tried taking out the if statements to just get the selection to work, but my offset portion does not work either.


Any help would be greatly appreciated!!!!

Thanks,

PIGUY

 

[piguy]

http://dl.dropbox.com/u/39517498/Book2.xls

AlphaFrog,

Here's a link to the excel file. I want to be able to delete out the empty cells left behind if I cut a "case" from one side and insert it on the other side. I've been playing around with a way to name the empty range if it moves, but have not been successful.

 

[AlphaFrog]

Sub MoveCase()
    Dim vRng As Variant, vRng2 As Variant
    Dim rng1 As Range, rng2 As Range
    
    On Error Resume Next
Retry1:
    ' Prompt for source copy range
    Set rng1 = Nothing: vRng1 = False
    vRng1 = Application.InputBox(Prompt:="Select a case from Column D or S", Type:=0)
    If vRng1 = False Then Exit Sub
    vRng1 = Replace(Replace(Application.ConvertFormula(vRng1, xlR1C1, xlA1), "=", ""), """", "")
    Set rng1 = Range(vRng1)
    If rng1 Is Nothing Then GoTo Retry1
    If rng1.Column <> 4 And rng1.Column <> 19 Then MsgBox "Select only from columns D or S.": GoTo Retry1
        
Retry2:
    ' Prompt for destination
    Set rng2 = Nothing: vRng = False
    vRng2 = Application.InputBox(Prompt:="Select location to move Case", Type:=0)
    If vRng2 = False Then Exit Sub
    vRng2 = Replace(Replace(Application.ConvertFormula(vRng2, xlR1C1, xlA1), "=", ""), """", "")
    Set rng2 = Range(vRng2)
    If rng2 Is Nothing Then GoTo Retry2
    If rng2.Column <> 4 And rng2.Column <> 19 Then MsgBox "Select only from columns D or S.": GoTo Retry2
    
    On Error GoTo 0
    
    Application.ScreenUpdating = False
    rng2.Offset(, -3).Resize(2, 15).Insert Shift:=xlDown
    rng1.Offset(, -3).Resize(2, 15).Cut Destination:=rng2.Offset(-2, -3)
    Range(vRng1).Offset(, -3).Resize(2, 15).Delete Shift:=xlShiftUp
    Application.ScreenUpdating = True
    MsgBox "The case has been moved"
End Sub