Solved: Insert a new row after finding text "total" in a cell

Hi,

I need a bit of code where i can insert a new row in a spreadsheet.
The scenario is that i have a page with subtotals on it, such as Monday Total, Tuesday Total and so on.

What i need is a bit of code to insert a new row below the total row (Monday Total, Tuesday Total and so on) when the row has the words "Total" in it. So the code knows to read the word Total and then insert a new line below it.
Is an IF statement needed here?

Any help at all appreciated.

Thanks

Steve

Is total only showing up a max of 1 time per sheet?

Hi Gavin,

Nope the word "Total" appears numerous times, could be 1-500 times.
The cell will always end with the word "Total" but will always have another name preceeding it, like Monday Total or John Total or Michael Total.

Thanks

Steve

can it be anywhere in the sheet or just say column A?

Hi,

It will always be in Cloumn A.

Thanks

Steve

Try this:

[vba]
Dim x As Integer

x = Columns(1).Find(what:="total", After:=Cells(1, 1),LookIn:=xlFormulas,
_ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row

With Cells(x, 1)
If .Value = "total" Then
.EntireRow.Insert xlShiftDown
End If
End With
[/vba]

Not sure if this will find them all or just one - if it is just one, you will need to add a loop to find the next one

This works though it could be made cleaner by removing selects. I keep screwing something up when doing that though...

[VBA]Option Explicit
Sub InsertAfterTotal()
Dim lastCell As Integer
Dim counter As Integer

lastCell = Range("A65536").End(xlUp).Row
counter = lastCell
Do
Range("A" & counter).Select

If Right(Trim(Selection), 5) = "Total" Then
Rows(counter + 1).Insert Shift:=xlDown

End If



counter = counter - 1
Loop Until counter = 0




End Sub
[/VBA]

Ha. Without trying this, it looks like if you were to loop it, you'd easily throw it into an infinite loop. You'll need to set a start row or something to keep track of where your first find result was so it knows to quit or you'll go around and around inserting rows.

Quote:

---

Originally Posted by f2e4

Try this:

[vba]
Dim x As Integer

x = Columns(1).Find(what:="total", After:=Cells(1, 1),LookIn:=xlFormulas,
_ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row

With Cells(x, 1)
If .Value = "total" Then
.EntireRow.Insert xlShiftDown
End If
End With
[/vba]

Not sure if this will find them all or just one - if it is just one, you will need to add a loop to find the next one

---

Thanks Guys for the repllies.
Think i do need some sort of loop.
Was thinking of this adding something like this in, would this do it?:

Do Until IsEmpty(ActiveCell.Offset(0, 1))
ActiveCell.Offset(1, 0).Select
Loop

if you use mine, it works as is.

Quote:

---

Originally Posted by obriensj

Thanks Guys for the repllies.
Think i do need some sort of loop.
Was thinking of this adding something like this in, would this do it?:

Do Until IsEmpty(ActiveCell.Offset(0, 1))
ActiveCell.Offset(1, 0).Select
Loop

---

ehh, the activecell business gets cumbersome. Doing it that way will also result in trouble for you if you have any blank rows or empty cells which unless your positive they'll never occur do tend to pop up.

Quote:

---

Originally Posted by grichey

Ha. Without trying this, it looks like if you were to loop it, you'd easily throw it into an infinite loop. You'll need to set a start row or something to keep track of where your first find result was so it knows to quit or you'll go around and around inserting rows.

---

Fine...try this then

[vba]Sub Find_total()
Dim Rng As Range, Foundit As String

With Sheet1.Range("A1:A100")
Set Rng = .Find(what:="total", After:=Cells(1, 1), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If Not Rng Is Nothing Then
Foundit = Rng.Address
Do
Rng.EntireRow.Insert xlShiftDown
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> Foundit
End If
End With

Set Rng = Nothing

End Sub[/vba]

Thanks Gavin for your help, worked a treat.

When looping to insert/delete rows, it's easier to start at the bottom. It avoids problems with repeated values in adjacent cells.
For large number of rows, I would use f2e4's Find solution.

[vba]
Option Explicit
Sub InsertAfterTotal()
Dim i As Long

For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Right(Cells(i, 1), 5) = "Total" Then
Cells(i + 1, 1).EntireRow.Insert
End If
Next
End Sub

[/vba]

Hi, sorry to thread hijack, but i am looking at doing a similar task, however it involves deleting some rows.

Firstly what i want the macro to do is to search the sheet, and when it finds the word "Termination" in Column B, it will delete all the rows above.
The word "Termination" can appear on different rows, depending on the size of the HTML import.

I tried to do this myself by amending Grichey's VBA script above, but when running, the debug catches an overflow error.

[VBA]

Option Explicit
Sub InsertAfterTotal()
Dim lastCell As Integer
Dim counter As Integer

lastCell = Range("A65536").End(xlDown).Row
counter = lastCell
Do
Range("B" & counter).Select

If Right(Trim(Selection), 5) = "Termination" Then
Rows(counter + 1).Insert Shift:=xlUp

End If



counter = counter - 1
Loop Until counter = 0




End Sub

[/VBA]

Thanks in advance for your help :)

Hi,

Try this bit of code.
Not very developed by any means but it worked for me.

Steve



[VBA]
Option Explicit
Sub DeleteRowText()
Cells.Find(What:="Termination", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
ActiveCell.Offset(1, 0).Select

Do Until ActiveCell = "Termination"
Selection.EntireRow.Delete
'ActiveCell.Offset(1, 0).Select
Loop

End Sub
[/VBA]

Quote:

---

Originally Posted by karldou

Hi, sorry to thread hijack, but i am looking at doing a similar task, however it involves deleting some rows.

Firstly what i want the macro to do is to search the sheet, and when it finds the word "Termination" in Column B, it will delete all the rows above.
The word "Termination" can appear on different rows, depending on the size of the HTML import.

---

Avoid the loop to speed up execution
[vba]
Sub DelRows()
Range(Cells(1, 2), Columns(2).Find(What:="Termination", _
After:=Cells(1, 2))).EntireRow.Delete
End Sub

[/vba]

Thanks mdmac! that worked perfectly!

thanks
Karl