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

 

[AlphaFrog]

Sub MoveCase()
    Dim rng As Range
Retry:
    Set rng = Nothing
    On Error Resume Next
    Set rng = Application.InputBox(prompt:="Select a case from Column D or S", Type:=8)
    On Error GoTo 0
    If rng Is Nothing Then Exit Sub 'User canceled
    If rng.Column = 4 Or rng.Column = 19 Then   'Test if selection is in columns D or S
        With rng
            .Offset(0, -3).Resize(, 14).Cut
            Range("A20").Insert Shift:=xlDown
            MsgBox "The case has been moved"
        End With
    Else: GoTo Retry
    End If
End Sub

 

[piguy]

AlphaFrog thanks for the reply!

I'm still getting an error with the offset portion of the macro. For some reason it's not offsetting the 3 cells to the left from the cell selected.

The offset works in my "active cell" macro, but not in this one.

Thanks in advance!

PIGUY

 

[piguy]

Here's a link to a sample file of what I'm trying to do. I put (2) buttons in the file attached to macros in cell AE34 and AE35.

The "Move Case Active Cell" macro works
The "Move Case" macro gets an error due to the merged cell. I'm still fuzzy on how to fix

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

 

[AlphaFrog]

My best advise would be to not use merged cells if at all possible. Having said that...

Sub MoveCase()
    Dim vRng As Variant, rng As Range
Retry:
    On Error Resume Next
        Set rng = Nothing: vRng = False
        vRng = Application.InputBox(Prompt:="Select a case from Column D or S", Type:=0)
        If vRng = False Then Exit Sub
        vRng = Replace(Replace(Application.ConvertFormula(vRng, xlR1C1, xlA1), "=", ""), """", "")
        Set rng = Range(vRng)
        If rng Is Nothing Then GoTo Retry
    On Error GoTo 0
    If rng.Column = 4 Or rng.Column = 19 Then   'Test if selection is in columns D or S
        rng.Offset(, -3).Resize(2, 15).Cut
        'Range("A20").Insert Shift:=xlDown
        Cells(20, rng.Column - 3).Insert Shift:=xlDown
        MsgBox "The case has been moved"
    Else: MsgBox "Select only from columns D or S.": GoTo Retry
    End If
End Sub

 

[piguy]

AlphaFrog,

Thanks a ton! I was playing around with it last night and was getting close. You got it! Now I'll try to add another input box to let them select where to paste the case they are moving.

Thanks again!!

PIGUY

 

[piguy]

Okay so now when I'm trying to add my 2nd input box to have the user select where to move the case, I'm losing the case that was previously cut. Looks like I'm just inserting a cell where I select the case to move to with the 2nd input box. 3hrs in and still not getting it to work

This is my first attempt with multiple input boxes obviously

Sub MoveCase()
    Dim vRng1 As Variant, rng1 As Range, vRng2 As Variant, rng2 As Range
    
    
Retry1:
    On Error Resume Next
        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
    On Error GoTo 0
    If rng1.Column = 4 Or rng1.Column = 19 Then   'Test if selection is in columns D or S
        rng1.Offset(, -3).Resize(2, 15).Cut
        
        'add second input box for where to move case
        Set rng2 = Nothing: vRng2 = 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 Retry1
    On Error GoTo 0
    If rng2.Column = 4 Or rng2.Column = 19 Then
        'rng2.Offset(, -3).Insert Shift:=xlDown (This loses the cell range cut and just inserts cell at 2nd input box location)
        Cells(rng2.Row, rng2.Column - 3).Insert Shift:=xlDown '2nd attempt.  Does same thing
        MsgBox "The case has been moved"
    Else: MsgBox "Select only from columns D or S.": GoTo Retry1
    End If
    End If
    
End Sub

 

[piguy]

Don't know why copying the selection over again to cut worked....but it did!

Sub MoveCase()
    Dim vRng1 As Variant, rng1 As Range, vRng2 As Variant, rng2 As Range
    
    
Retry1:
    On Error Resume Next
        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
    On Error GoTo 0
    If rng1.Column = 4 Or rng1.Column = 19 Then   'Test if selection is in columns D or S
        rng1.Offset(, -3).Resize(2, 15).Cut
        
        'add second input box for where to move case
        Set rng2 = Nothing: vRng2 = 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 Retry1
    On Error GoTo 0
    If rng2.Column = 4 Or rng2.Column = 19 Then
        rng1.Offset(, -3).Resize(2, 15).Cut 'copied again from above??
        rng2.Offset(, -3).Insert Shift:=xlDown
        MsgBox "The case has been moved"
    Else: MsgBox "Select only from columns D or S.": GoTo Retry1
    End If
    End If
    
End Sub

 

[piguy]

Ok last thing needed. Promise!!
I got have the move case working now (also made a button and macro to insert case that was fairly simple).

Problem I have left is that if I move a case from Column S side to Column D side (or vice versa) I will be left with the empty cells I cut. When I try to write an if statement to compare rng1.column with rng2.column I will always get them as the same column at the end of macro (because they have been moved.

I tried using the original vRng1 anv vRng2 to compare, but I get object errors when I try to run it.

Scratching my head on this last part!

 

[AlphaFrog]

Problem I have left is that if I move a case from Column S side to Column D side (or vice versa) I will be left with the empty cells I cut. When I try to write an if statement to compare rng1.column with rng2.column I will always get them as the same column at the end of macro (because they have been moved.

I don't follow. I understand that you will have two fewer rows on one side and two more rows on the other side. I don't know what you want to do after you cut-paste from one side to the other.