VBA to Search Column, Cut & Move Specified Cells

[cvincent]

I am using Excel 2010, and when I download data into Excel, the Totals Row doesn't line up with the rest of the data. The totals row ends up in Column A, while the data starts in Column B. I am therefore trying to create a macro that will search Column A for the word "Range", then select that cell along with the adjoining cells to the right, cut and paste them one column to the right. This is the code I am using, but I am getting a runtime error 424 - Object Required error. I am not a pro in VBA, so assistance would be appreciated as to what I am doing wrong, or what I need. Thank you!

Sub AdjustTotalsRows()
'
' AdjustTotalsRows Macro
'

'
Dim rCell As Range
Dim rRng As Range

Set rng = Range("A:A")
For Each rCell In rRng
If rCell.Value = "TOTAL" Then
rCell.Select
ActiveCell.Range("A1:J1").Select
Selection.Cut
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, -1).Range("A1").Select

End If
Next rCell

End Sub

 

[mumps]

Try:

Sub AdjustTotalsRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rRng As Range
    For Each rRng In Range("A2:A" & LastRow)
        If rRng = "TOTAL" Then
            Range("A" & rRng.Row & ":J" & rRng.Row).Cut rRng.Offset(0, 1)
        End If
    Next rRng
    Application.ScreenUpdating = True
 End Sub

 

[cvincent]

Thank you so very much, Mumps! Worked like a charm

 

[Rick Rothstein]

Try:

Sub AdjustTotalsRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rRng As Range
    For Each rRng In Range("A2:A" & LastRow)
        If rRng = "TOTAL" Then
            Range("A" & rRng.Row & ":J" & rRng.Row).Cut rRng.Offset(0, 1)
        End If
    Next rRng
    Application.ScreenUpdating = True
 End Sub

If the cells in Column A are blank except for the ones containing the word "TOTAL" (which the OP's post seems to suggest), then the macro could be simplified to this...

Sub AdjustTotalsRows()
  Columns("A").SpecialCells(xlConstants).Insert xlShiftToRight
End Sub

otherwise this would work...

Sub AdjustTotalsRows()
  Columns("A").Replace "TOTAL", "#N/A", xlWhole
  Columns("A").SpecialCells(xlConstants, xlErrors).Insert xlShiftToRight
  Columns("B").Replace "#N/A", "TOTAL", xlWhole
End Sub

 

[mumps]

@ cvincent: You are very welcome.
@ Rick: Efficient and interesting solution as usual.

 

[cvincent]

Thank you Rick! It is working great now, but I will give this a try as well when I do tomorrow's reports