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.
Originally Posted by f2e4
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.
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.
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]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
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[/VBA]
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
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]
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]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
Thanks mdmac! that worked perfectly!
thanks
Karl
Posting Permissions
Reply With Quote
