excel macro to move cell contents down 1 row if criteria is met?

This little baby does what you ask:

Sub MoveTotalsDown()

  Dim booWorking As Boolean

  Dim rng As Range

  Set rng = Cells.SpecialCells(xlCellTypeLastCell)

  Set rng = rng.EntireRow.Range("A1")

  booWorking = True

  Do While booWorking

    If Left(rng.Value, 13) = "***TOTALS FOR" Then

      rng.Offset(1).Value = rng.Value

      rng.Value = ""

    End If

    If rng.Row = 1 Then booWorking = False

    If rng.Row > 1 Then Set rng = rng.Offset(-1)

  Loop

End Sub

Note that my first attempt started from the top down and I just skipped the row when I copied one down but I realized that you might have two in order so the correct solution is to work from the bottom up.

Hope that helps…

1

Before you try to accomplish this task, you have to wonder if that is possible:

Let's say you have the macro to do that.

The macro would search according to defined criteria all down column A, and once it finds a cell meeting the criteria, it moves it down 1 row. As the macro will meet the moved cell with the defined criteria, it will move down 1 row again, till the end of the column.

What's the point of this macro?

I always use a nested loop to do that.... Dim lvarRIGHT As Integer Dim lvarDOWN As Integer Dim cellcontent As String For lvarDOWN = 1 To 6 For lvarRIGHT = 1 To 5 Cells(lvarDOWN, lvarRIGHT).Select Let cellcontent = Cells(lvarDOWN, lvarRIGHT) If cellcontent = "123" Then Let Cells(lvarDOWN, lvarRIGHT) = "ABC" End If Next Next This will go cell by cell over 5 and down 6. It checks the content of the cell and if it is 123 it replaces it with ABC

Randy gives a great answer. It wasn't clear to me if you want to shift the contents of "***TOTALS FOR" down by copying it to the next cell below or by inserting a new blank cell and shift "***TOTALS FOR" down. The macro below inserts a cell (if that's what you want) instead of copying the contents of the cell. If you don't want to insert a new cell and shift everything down, then Randy's macro is the way to go.

Sub Move_totals_down()

Dim r As Long

Application.ScreenUpdating = False

For r = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1

If InStr(Cells(r, "A").Text, "***TOTALS FOR") > 0 Then Cells(r, "A").Insert Shift:=xlDown

Next r

Application.ScreenUpdating = True

End Sub

This insert a new cell just for the cells in column A. If you want to shift the entire row down one row, replace in the code...

.Insert Shift:=xlDown

with...

.EntireRow.Insert Shift:=xlDown

why do you answer questions you don't know about.