VBA remember original row number when cutting and inserting

[Pfeifer]

Hello all first time post here, apologize if it's done incorrectly.

Set up a grouping macro that enables base-level Excel users to group two or more rows together when performing a remit reconciliation. Have everything working fine except when I'm trying to rough-in an undo function in case the users group the wrong rows. The macro cuts and pastes a row, where the user prompts which row should be cut and which row the cut row should be inserted above. At the end, I'm trying to build in a verification that the user is fine with the cut and paste that just occurred. If they're not, I'd like the row that was just cut and inserted to be placed back in it's original location. In the code, anything referring to HomeAdd or HomeRow was my attempt to store the original row number. My explanation might not be the most clear, would be happy to answer follow up questions.

Thanks in advance!

Sub Group()

Dim OriginalCell As Range
Dim DestinationCell As Range
Dim HomeAdd As String
Dim HomeRow As Range
'Dim Diff As Range
Dim answer As Integer

On Error Resume Next
Set OriginalCell = Application.InputBox(Prompt:="Select Original to Add To", Title:="Select Home", Type:=8)

If OriginalCell Is Nothing Then
    MsgBox "No selection made", vbCritical, "Input required"
    Exit Sub
End If


On Error Resume Next
Set DestinationCell = Application.InputBox(Prompt:="Select Additional Cell", Title:="Select Addition", Type:=8)

If DestinationCell Is Nothing Then
    MsgBox "No selection made", vbCritical, "Input required"
    Exit Sub
End If

DestinationCell.Select
'Set HomeAdd = Range("DestinationCell").Address
'Set HomeRow = Range(HomeAdd).Row
Set HomeRow = Selection.Row


DestinationCell.EntireRow.Select
Selection.Cut
OriginalCell.EntireRow.Select
Selection.Insert Shift:=xlDown
OriginalCell.EntireRow.Select
Selection.End(xlToRight).Select


    If ActiveCell.Offset(-2, 0) = "" Then
        ActiveCell.Offset(-1, -4).Select
        Selection.ClearContents
        Selection.End(xlToRight).Select
        Selection.ClearContents
        ActiveCell.EntireRow.Select
        Selection.borders(xlDiagonalDown).LineStyle = xlNone
        Selection.borders(xlDiagonalUp).LineStyle = xlNone
        Selection.borders(xlEdgeLeft).LineStyle = xlNone
        Selection.borders(xlEdgeTop).LineStyle = xlNone
        Selection.borders(xlEdgeBottom).LineStyle = xlNone
        Selection.borders(xlEdgeRight).LineStyle = xlNone
        Selection.borders(xlInsideVertical).LineStyle = xlNone
        Selection.borders(xlInsideHorizontal).LineStyle = xlNone
        ActiveCell.Offset(1, 0).Select
    Else
        ActiveCell.Offset(-1, -4).Select
        Selection.ClearContents
        ActiveCell.Offset(1, 0).Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = "=SUM(R[-1]C[-1]:RC[-1])"
        Selection.End(xlToRight).Select
        ActiveCell.FormulaR1C1 = _
        "=IF(RC[-4]="""","""",IFERROR(RC[-4]-SUM(R[-1]C[-1]:RC[-1]),RC[-4]))"
        ActiveCell.Offset(-1, 0).Select
        Selection.ClearContents
        ActiveCell.EntireRow.Select
        Selection.borders(xlDiagonalDown).LineStyle = xlNone
        Selection.borders(xlDiagonalUp).LineStyle = xlNone
        Selection.borders(xlEdgeLeft).LineStyle = xlNone
            With Selection.borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlMedium
            End With
        Selection.borders(xlEdgeBottom).LineStyle = xlNone
        Selection.borders(xlEdgeRight).LineStyle = xlNone
        Selection.borders(xlInsideVertical).LineStyle = xlNone
        Selection.borders(xlInsideHorizontal).LineStyle = xlNone
        ActiveCell.Offset(1, 0).Select
    End If
    
'section to add Yes/No box - acts as an UNDO
answer = MsgBox("Is this grouping correct?", vbQuestion + vbYesNo)

    If answer = vbNo Then
        ActiveCell.Offset(-1, 0).Select
        ActiveCell.EntireRow.Select
        Selection.Cut
        HomeRow.Select
        Selection.Insert Shift:=xlDown
        MsgBox "Grouping Cancelled"
        
        Else
        MsgBox "OK"
        End If

End Sub

 

[johnnyL]

@Pfeifer I think you should move your grouping question up to right after the row is relocated and before any changes are made to cell values.

In other words change:

If OriginalCell Is Nothing Then
    MsgBox "No selection made", vbCritical, "Input required"
    Exit Sub
End If


On Error Resume Next
Set DestinationCell = Application.InputBox(Prompt:="Select Additional Cell", Title:="Select Addition", Type:=8)

If DestinationCell Is Nothing Then
    MsgBox "No selection made", vbCritical, "Input required"
    Exit Sub
End If

DestinationCell.Select
'Set HomeAdd = Range("DestinationCell").Address
'Set HomeRow = Range(HomeAdd).Row
Set HomeRow = Selection.Row


DestinationCell.EntireRow.Select
Selection.Cut
OriginalCell.EntireRow.Select
Selection.Insert Shift:=xlDown
OriginalCell.EntireRow.Select
Selection.End(xlToRight).Select

to something like the following:

    If OriginalCell Is Nothing Then                                                             ' If 'Cancel' or Red 'X' was selected then ...
        MsgBox "No selection made", vbCritical, "Input required"                                '   Notify User
        Exit Sub                                                                                '   Exit Sub
    End If
'
    OriginalCellRow = OriginalCell.Row                                                          ' Save original cell row
'
    On Error Resume Next
    Set DestinationCell = Application.InputBox(Prompt:="Select Additional Cell", Title:="Select Addition", Type:=8) ' 8 = cell reference, as a Range object
'
    If DestinationCell Is Nothing Then                                                          ' If 'Cancel' or Red 'X' was selected then ...
        MsgBox "No selection made", vbCritical, "Input required"                                '   Notify User
        Exit Sub                                                                                '   Exit Sub
    End If
'
    DestinationCellRow = DestinationCell.Row                                                    ' Save Destination cell row
'
    DestinationCell.Select
''    Set HomeRow = Selection.Row
'
    DestinationCell.EntireRow.Cut                                                               ' Select that entire row & Cut
'
    OriginalCell.EntireRow.Insert Shift:=xlDown                                                 ' Insert destination row above original cell row
'
'   section to add Yes/No box - acts as an UNDO
    answer = MsgBox("Is this grouping correct?", vbQuestion + vbYesNo)
'
    If answer = vbNo Then
        Rows(OriginalCellRow).Cut
        Rows(DestinationCellRow + 1).Insert
        Exit Sub
''        ActiveCell.Offset(-1, 0).EntireRow.Cut
''        HomeRow.Select
''        Selection.Insert Shift:=xlDown
''        MsgBox "Grouping Cancelled"
''    Else
''        MsgBox "OK"
    End If

 

[Pfeifer]

@johnnyL That worked for the most part, thank you. I did have to slightly change 2 lines to get it to work as intended, but overall great guidance.

I had to change:

   If answer = vbNo Then
        Rows(OriginalCellRow).Cut
        Rows(DestinationCellRow + 1).Insert
        Exit Sub

To:

    If answer = vbNo Then
        DestinationCell.EntireRow.Cut
        Rows(DestinationCellRow).Insert
        End If

Thank you for your help!

 

[johnnyL]

Your 1st line change does the same thing as what I suggested.
Your 2nd line change will not put the line back where it came from, it will be off by 1 line. Is that your intention?