Macro to insert rows part II

[Jillbeirne]

A few days ago I posted this question:

i needed a macro that would go through the cells in column A, which is a list of adverstiser and insert a row when the name of the advertiser changed. So the macro needs to compare each cell to the one before and when the values differ, insert a macro. But I need one that will first go through column A, and then once finished with the items in A, go through column B and do the same thing. Can't get the column B to work... Thanks so much for any help!

-J

 

[The_Rock]

Hi GaryB
Found this old post and I hope you're still around to help or someone else who maybe able to.

I have got your formula to work for me. I need to expand it so it will go through the remaining 6 tabs that I have.

Data is layed out in exactly the same way, just need it so that one macro will insert a row in all the tabs, not just the one that the macro has been recorded on.

Cheers

 

[GaryB]

Hi

Give this a go.....

Dim i As Long
Dim Col As Integer
Dim ws As Worksheet

For Each ws In Worksheets
ws.Select

For Col = 1 To 2

r = Cells(65536, Col).End(xlUp).Row

adv = Cells(r, Col).Value

For i = r To 2 Step -1
If Cells(i, Col).Value = "" Then
i = i - 1 '**
adv = Cells(i, Col) '**
Else
If Cells(i, Col).Value <> adv Then
adv = Cells(i, Col).Value
Rows(i + 1).Insert
End If
End If
Next i
Next Col
Next ws
End Sub

Hope this helps


GaryB

 

[The_Rock]

Perfect, Thank you very much

 

[JesterX1313]

Hey, this code is great. It also helps me out quite a bit. I was wondering if someone could tell me how I would make it add 6 rows instead of 1 and put a page break at the bottom of the 6 rows? Thanks for any help you can give me.

 

[GaryB]

Hi Jester,

Try this; It's basically the same, but runs thru the list once it's separated and then adds in the page breaks and 5 more blank rows,

Dim i As Long
Dim Col As Integer
Dim ws As Worksheet

For Each ws In Worksheets
ws.Select

For Col = 1 To 2

r = Cells(65536, Col).End(xlUp).Row

adv = Cells(r, Col).Value

For i = r To 2 Step -1
If Cells(i, Col).Value = "" Then
i = i - 1 '**
adv = Cells(i, Col) '**
Else
If Cells(i, Col).Value <> adv Then
adv = Cells(i, Col).Value
Rows(i + 1).Insert
End If
End If
Next i
Next Col

r = Cells(65536, 1).End(xlUp).Row

For i = r To 2 Step -1
If Cells(i, 1).Value = "" Then
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(i + 1, 1)
Rows(i & ":" & i + 4).Insert Shift:=xlDown
End If
Next i


Next ws
End Sub

Hope this helps

GaryB

 

[babelfish]

Currently using the following code to insert 5 lines where the entry in column 2 changes.
The entry in column 2 is either 6 digits (ie 303277) or 8 digits (302188jf).
Where it is 8 digits, I just want it take into account the first 6 digits only. ie take 302188jf and 302188jg as the same.
Any ideas?

Sub InsertRows()
Dim r As Long
Dim adv As String
Dim i As Long

r = Cells(Rows.Count, "A").End(xlUp).Row

adv = Cells(r, 2).Value

For i = r To 2 Step -1
If Cells(i, 2).Value = "" Then
adv = Cells(i - 1, 2).Value
Else

If Cells(i, 2).Value <> adv Then
adv = Cells(i, 2).Value
Rows(i + 1).Insert
Rows(i + 1).Insert
Rows(i + 1).Insert
Rows(i + 1).Insert
Rows(i + 1).Insert
End If
End If
Next i

End Sub

 

[babelfish]

I also want to have some text included in the inserted lines. Is there any way of doing this. I guess another macro may be needed for the text only to be inserted.

 

[GaryB]

if you just want to check the first 6 digits, you could use Left() to achieve this. i.e instead of Cells(r,2) use Left(Cells(r,2),6)

As far as inserting the text goes, why not insert it as you go along. Each time you insert a row you know exactly which blank line you have inserted so fill in the blanks as you go.

Sub InsertRows()
Dim r As Long
Dim adv As String
Dim i As Long

r = Cells(Rows.Count, "A").End(xlUp).Row

adv = Left(Cells(r, 2), 6)

For i = r To 2 Step -1
If Left(Cells(i, 2), 6) = "" Then
adv = Left(Cells(i - 1, 2), 6)
Else

If Left(Cells(i, 2), 6) <> adv Then
adv = Left(Cells(i, 2), 6)
Rows(i + 1).Insert
Cells(i + 1, 1) = "text5a"
Cells(i + 1, 2) = "text5b"
Rows(i + 1).Insert
Cells(i + 1, 1) = "text4a"
Cells(i + 1, 2) = "text4b"
Rows(i + 1).Insert
Cells(i + 1, 1) = "text3a"
Cells(i + 1, 2) = "text3b"
Rows(i + 1).Insert
Cells(i + 1, 1) = "text2a"
Cells(i + 1, 2) = "text2b"
Rows(i + 1).Insert
Cells(i + 1, 1) = "text1a"
Cells(i + 1, 2) = "text1b"
End If
End If
Next i

End Sub

Note: as you are inserting lines above the previous insertions, the fifth blank effectively is inserted first, and the first line, last.

Hope this helps

GaryB

 

[jessjones5]

I am trying to use the following macro, copied from above:
Dim r As Long
Dim adv As String
Dim i As Long
Dim Col As Integer
For Col = 1 To 2
r = Cells(65536, Col).End(xlUp).Row
adv = Cells(r, Col).Value
For i = r To 2 Step -1
If Cells(i, Col).Value = "" Then
i = i - 1 '**
Else
If Cells(i, Col).Value <> adv Then
adv = Cells(i, Col).Value
Rows(i + 1).Insert
End If
End If
Next i
Cells.Select
Next Col
Dim rCell As Range

My data is in column A & B, plus I have subtotals. Before I run the macro my data looks like:

aa
ab
ab
ab
total


The macro works for the most part, but if column a and b are the same it still puts a line between them if it is the row right before the subtotal. In my example abouve it inserts a line after aa, after the second ab, after the third ab, and after total. This is my first attempt at macros so I apologize if I am not making any sense.