Cut and Paste Insert Cells if It Contains a Value

OilEconomist

Active Member
Joined
Dec 26, 2016
Messages
439
Office Version
  1. 2019
Platform
  1. Windows
Hello and thanks in advance to all those who attempt to assist and I will post a response on feedback to proposed solutions.

I have a large data set which consists of more than 200,000 rows. I am searching column R to see if has total in it. If it does, I select it and all the cells within that row to the right of it up until the last cell (last column). I then cut it, and past it in the row below it starting in column A. Since there is data already in Columns A through Q all the way up to the last row of the spreadsheet, I have to insert the cut data. When I run the following code, nothing happens. Any insight on why?

Code:
Sub Total()


    'Activate the sheet
        Worksheets("Data.Raw").Activate




    'Find the last row.
        Dim LastRow As Long
              
        LastRow = Cells.Find(What:="*", _
        after:=Range("A1"), _
        LookAt:=xlPart, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False).Row
        
    'Find the last column.
        Dim LastColumn As Long
        
        LastColumn = Cells.Find(What:="*", _
        after:=Range("A1"), _
        LookAt:=xlPart, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByColumns, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False).Column
        




    'Move Total Line within the Data Set
        
        Dim i As Long
        
        For i = LastRow To 1 Step -1
        
           If LCase(Cells(i, 18).Value) = "Total" Then
        
           Range("R" & i, LastColumn).Cut
             
           Range("A" & i + 1).Insert xlShiftDown
                      
           
        End If
        
        Next i
        


End Sub

Once again thanks!
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
Try
Code:
Range("R" & i, Cells(i, Lastcolumn)).Cut
You also need to change this
Code:
If LCase(Cells(i, 18).Value) = "[COLOR=#ff0000]t[/COLOR]otal" Then
 
Last edited:
Upvote 0
Solution
For 200,000 rows this should be quicker
Code:
Sub Total()
   Dim Lc As Long
   Dim Ar As Areas
   Dim i As Long

   Worksheets("Data.Raw").Activate
   
   Lc = Cells.Find(What:="*", _
      after:=Range("A1"), _
      LookAt:=xlPart, _
      lookIn:=xlFormulas, _
      SearchOrder:=xlByColumns, _
      SearchDirection:=xlPrevious, _
      MatchCase:=False).Column
   With Range("R1", Range("R" & Rows.Count).End(xlUp))
      .Replace "total", "=XXXTotal", , , False, , False, False
      Set Ar = .SpecialCells(xlFormulas, xlErrors).Areas
      .Replace "=XXXTotal", "Total", , , False, , False, False
   End With
   For i = Ar.Count To 1 Step -1
      Ar(i).Offset(1).EntireRow.Insert xlDown
      Range(Ar(i), Cells(Ar(i).Row, Lc)).Cut Cells(Ar(i).Row + 1, 1)
   Next i
End Sub
 
Upvote 0
Thanks Fluff! I used the corrections that you posted in Post #2 and that worked. When I get a chance I will try to test the alternative faster method in Post #3 as I would like to make my spreadsheet as efficient as possible.
 
Upvote 0
You're welcome & thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,223,907
Messages
6,175,300
Members
452,633
Latest member
DougMo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top