How to reorder without changing SUM

Question

The Code below reorders a set of values in a specific range in one sheet to match another sheet (in a pivot table). The problem is that when it reorders it changes the SUM formulas in adjacent rows. How can I prevent this?


Sub Reorder()


Dim First As String
Dim Range1 As Range
Dim Range2 As Range
Dim lRow As Long
Dim Count As Long
Dim Net As String
Dim Line As Range
Dim Netrng As Range
Dim Swith As Range

    If ActiveCell.Column = 2 Then
    First = ActiveCell.Address
    ActiveWindow.ActivatePrevious

    ActiveSheet.Range("B5").Activate
    lRow = Cells(Rows.Count, 1).End(xlUp).row - 6
    Set Range2 = Range(ActiveCell.Offset(3, -1), ActiveCell.Offset(lRow, -1))


    Count = 1
      While Count <= Range2.Count
      Set Line = Range2.Rows(Count)
      Net = Line.Value


      ActiveWindow.ActivatePrevious

      Set Range1 = Range(First, Range(First).End(xlDown))
      Range1.Activate
      Set Netrng = Range1.Find(What:=Net, After:=ActiveCell, LookIn:=xlValues, _
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False)


      If Not Netrng Is Nothing And Netrng.row <> Range1.Rows(Count).row Then
       Rows(Netrng.row & ":" & Netrng.row).Select
       Selection.Cut
       Rows(Range1.Rows(Count).row & ":" & Range1.Rows(Count).row).Select
       Selection.Insert Shift:=xlDown
      End If
      ActiveWindow.ActivatePrevious
      Count = Count + 1
      Wend
 Else
MsgBox "Please select correct column"
End If


End Sub

A sample screenshot of the before and after might be helpful here. — BigBen, Jan 21 '20 at 21:21
Side note - `While...Wend` is obsolete. Use `Do While...Loop`. — BigBen, Jan 21 '20 at 21:22
Don't use `Cut` -- that is the source of the problem. Side note: in general,. you want to [avoid using select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) in your code — cybernetic.nomad, Jan 21 '20 at 21:31

How to reorder without changing SUM

0 Answers0