Macro to copy previous row and insert two blank rows

[dd]

Hi,
I'm working on a excel sheet that contains about 5000 rows of data.
What I need to do is to look at column A and go through the rows and
whenever the row has the text "Total Spend" I need to copy it to the
following row with "Total N Spend" and insert two blank rows after
that. So for example:

Column A
Row 1 Apple
Row 2 IBM
Row 3 Dell
Row 4 Total Spend - Computer
Row 5 (Would copy row 4) Total N Spend - Computer
Row 6 Insert Blank Row
Row 7 Insert Blank Row
Row8 CarA
Row9 CarB
Row10 Total Spend - Cars
Row11 Total N Spend - Cars
Row12 Insert Blank Row
etc.

Previously someone helped me with this code below but nothing happens
after I run this macro.
Any help is appreciated, Thank you.



Sub TotalSpend()


Dim iCount As Integer
Dim iMax As Integer
Dim iLength As Integer


iCount = 1
iMax = WorksheetFunction.CountA(Sheets("Sheet1").Columns(1))


Do Until Left(Sheets("Sheet1").Cells(iCount, 1).Value, 11) = "Total
Spend -"
iCount = iCount + 1
Select Case iCount
Case Is > iMax
MsgBox "Some data must be missing in Column A of Sheet1."
Exit Sub
End Select
Loop


iLength = Len(Sheets("Sheet1").Cells(iCount, 1).Value)


Sheets("Sheet1").Cells(iCount + 1, 1).Value = "Total N Spend - " & _
Right(Sheets("Sheet1").Cells(iCount, 1).Value, iLength - 14)


End Sub

 

[Don Guillett]

Change the column from mc to suit your column number. If you want TWO blank
rows change resize(2,1) to 3,1

Sub addrowsandtext()
mc = 6
For i = Cells(Rows.Count, mc).End(xlUp).Row To 2 Step -1
If UCase(Left(Cells(i, mc), 5)) = "TOTAL" Then
Cells(i + 1, mc).Resize(2, 1).EntireRow.Insert
Cells(i + 1, mc).Value = "Total N " & _
Right(Cells(i, mc), Len(Cells(i, mc)) - 6)
End If
Next i
End Sub