Macro - How Do You Delete Rows With Bold Text?

bhrjohnson

Board Regular
Joined
Oct 8, 2004
Messages
56
The following macro works well for me except that it leaves many useless lines that all have one thing in common: the text in their A cell is bold, and no other cells except the header (row 1) contain bold text. How can I add a line to the END of this macro that will search all rows (except row 1) and delete the whole row if the A cell of the given row is bold?

Thanks,
Bill


Sub test()
Dim cell As Range, myrange As Range
Application.ScreenUpdating = False
Columns("A:A").Insert shift:=xlToRight
With Range("A1")
.Value = "Family Name"
.Font.Bold = True
.WrapText = True
End With
Set myrange = Range("B2", Range("B65536").End(xlUp))
For Each cell In myrange
If cell.Font.Bold = True Then cell.Cut Destination:=cell.Offset(, -1) Else _
cell.Offset(, -1).Value = cell.Offset(-1, -1).Value
Next
Application.ScreenUpdating = True
End Sub
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
51,139
Office Version
365
Platform
Windows
When deleting entire rows, you need to work through your range backwards (from the bottom to top) to not miss any rows.

Here is a little code that will delete all lines in column B (except row 1) where the entry in column B is bold:
Code:
    Dim i As Long
    For i = Range("B65536").End(xlUp).Row To 2 Step -1
        If Cells(i, "B").Font.Bold = True Then Rows(i).EntireRow.Delete
    Next i
You could probably also work the code you are doing in your loop on column B into this same loop as well.
 

bhrjohnson

Board Regular
Joined
Oct 8, 2004
Messages
56
Thank you. Where do I add this? Just before End Sub of the original macro? Sorry for my ignorance, but someone else came up with the original macro for me. I don't know much about macros.

Bill
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
51,139
Office Version
365
Platform
Windows
Right after the "Next" in your code.

It would be far more efficient to combine the two loops into one, since they are both being run on the exact same range (column B).

What is the your intention with the loop in your original code? It looks like it may be moving cells around. Is this code I gave you supposed to replace it, or run in addition to it?
 

bhrjohnson

Board Regular
Joined
Oct 8, 2004
Messages
56
It's kind of difficult even to explain. I have 2-level heirachrcical text that is all in column A. I need all bold (level 1) text to fill down column A - but only until it reaches the next bold text - and the sub text to shift over into column B. The macro works perfectly except I just need to delete out all of the remining bold level 1 rows that do not have any level 2 data next to them. Because the main macro keys off of bold text I need it to complete before it moves onto this new part that will delete out the remining bold lines.

The original list looked like this:

big
dog
cat
fish
small
cat
fish
mouse

and the main macro makes it look like this:
big
big dog
big cat
big fish
small[/b]
small cat
small fish
small mouse

I want this:
big dog
big cat
big fish
small cat
small fish
small mouse
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
51,139
Office Version
365
Platform
Windows
There is probably a more efficient way of doing this, but I incorporated the code into your macro (but had to run it on column A, not B, because the bolding is still in column A) and it seems to work:
Code:
Sub test()

    Dim cell As Range, myrange As Range, i As Long
    
    Application.ScreenUpdating = False
    
    Columns("A").Insert shift:=xlToRight
    
    With Range("A1")
        .Value = "Family Name"
        .Font.Bold = True
        .WrapText = True
    End With
    
    Set myrange = Range("B2", Range("B65536").End(xlUp))
    For Each cell In myrange
        If cell.Font.Bold = True Then cell.Cut Destination:=cell.Offset(, -1) Else _
            cell.Offset(, -1).Value = cell.Offset(-1, -1).Value
    Next
    
    For i = Range("A65536").End(xlUp).Row To 2 Step -1
        If Cells(i, "A").Font.Bold = True Then Rows(i).EntireRow.Delete
    Next i
    
    Application.ScreenUpdating = True
    
End Sub
 

Forum statistics

Threads
1,078,074
Messages
5,338,048
Members
399,200
Latest member
dttate66

Some videos you may like

This Week's Hot Topics

Top