VBA to Search Column, Cut & Move Specified Cells

cvincent

Board Regular
Joined
Aug 28, 2011
Messages
66
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

Well-known Member
Joined
Apr 11, 2012
Messages
8,502
Try:
Code:
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
 
Last edited:

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
35,496
Office Version
2010
Platform
Windows
Try:
Code:
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...
Code:
Sub AdjustTotalsRows()
  Columns("A").SpecialCells(xlConstants).Insert xlShiftToRight
End Sub
otherwise this would work...
Code:
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

Well-known Member
Joined
Apr 11, 2012
Messages
8,502
@ cvincent: You are very welcome. :)
@ Rick: Efficient and interesting solution as usual.
 

cvincent

Board Regular
Joined
Aug 28, 2011
Messages
66
Thank you Rick! It is working great now, but I will give this a try as well when I do tomorrow's reports :)
 

Forum statistics

Threads
1,081,415
Messages
5,358,533
Members
400,502
Latest member
price83

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top