Add row below bold text

[Deverti]

Im simply trying to add empty rows below each text in bold font in column A

It seems to be doing what i need but once i actually use "insert" my excel times out and freezes.
I probably just need to add rows from the bottom up instead, not sure tho.

+ screwed up the title with above/below but it doesnt change a whole lot for the code i suppose

Sub AddBufferBelowBold()
Dim rngA As Range
Dim vCell As Range
    lRow = Range("A" & Rows.Count).End(xlUp).Row
    Set rngA = Range("A12:A" & lRow)

    For Each vCell In rngA
        If vCell.Font.Bold = True Then
            vCell.Offset(1).EntireRow.Select    'insert
        End If
    Next vCell

End Sub

 

[smozgur]

Insert function also copies the font bold property. So it is an endless loop. That should be the reason for the freeze.

I would do that with counters instead of looping through the range. Setting the next row's font bold property is only if you need to run the code twice with empty rows.

Sub AddBufferBelowBold()
Dim lrow As Integer
Dim i As Integer
    lrow = Range("A" & Rows.Count).End(xlUp).Row
    For i = 12 To lrow
        With Range("A" & i)
            If .Font.Bold Then
                .Offset(1).EntireRow.Insert xlDown
                .Offset(1).Font.Bold = False
                lrow = lrow + 1
                i = i + 1
            End If
        End With
    Next i
End Sub

Note: I changed the title.

 

[mohadin]

Hi
What about

Sub AddBufferBelowBold()
Dim Lrow, i
    Lrow = Range("A" & Rows.Count).End(xlUp).Row
   For i = Lrow To 2 Step -1
        If Cells(i, 1).Font.Bold = True Then
            Cells(i, 1).Offset(1).EntireRow.Insert
        End If
    Next
End Sub

 

[Deverti]

Ooh, i wasnt aware inserting a row as such copies the entire format and repeats itself into oblivion.

smozgur, using your variation here disregards the added rows within the count, so whatever exceeds the original "lrow" is ignored.
not sure how to fix this other than just replacing "lrow" with a high enough number, which is totally fine but not ideal

For i = 12 To lrow

aside from that both of these options work perfectly, thanks a bunch.

 

[mohadin]

You are welcome
Thank you for the feedback
Be Happy

 

[mohadin]

BTW
you may

Sub AddBufferBelowBold()
    Dim Lrow, i
    Lrow = Range("A" & Rows.Count).End(xlUp).Row
    For i = Lrow To 2 Step -1
        With Cells(i, 1)
            If .Font.Bold = True Then
                .Offset(1).EntireRow.Insert
                .Offset(1).Font.Bold = False
            End If
        End With
    Next
End Sub