VBA - Delete rows that DO NOT contain Bold font

[JamesonMH]

Hi there,

I know this is a pretty easy one, but can't get this to work. I have a bunch of data rows and if all the cells are not Bold in a row, then delete the row (just delete within data range, not entire row). Otherwise, if there is a cell in the row that is Bold, then leave row as is.

[TABLE="width: 500"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Code[/TD]
[/TR]
[TR]
[TD]Store 1[/TD]
[TD]500[/TD]
[/TR]
[TR]
[TD]Store 3[/TD]
[TD]275
[/TD]
[/TR]
[TR]
[TD]Store 7[/TD]
[TD]480[/TD]
[/TR]
[TR]
[TD]Store 2[/TD]
[TD]450[/TD]
[/TR]
</tbody>[/TABLE]

With above example, I'd only want the Store 3 & Store 7 rows to remain (excluding headers).

Thanks!
James

 

[jamescooper]

[FONT=&quot]https://www.extendoffice.com/documents/excel/3320-excel-delete-if-not-bold.html

Can you adapt that code?

[/FONT]

 

[Rick Rothstein]

You did not tell us what the range is nor the starting row for your data (excluding the header), so I guessed... change the red highlighted parts as needed...

Sub DeleteRowsIfAllCellsAreNotBold()
  Dim R As Long, StartRow As Long, EndRow As Long, DataCols As String
  DataCols = "[B][COLOR="#FF0000"]D:E[/COLOR][/B]"
  StartRow = [B][COLOR="#FF0000"]2[/COLOR][/B]
  EndRow = Cells(Rows.Count, Columns(DataCols).Resize(, 1).Column).End(xlUp).Row
  For R = StartRow To EndRow
    If Intersect(Rows(R), Columns(DataCols)).Font.Bold = False Then Intersect(Rows(R), Columns(DataCols)).Delete xlShiftUp
  Next
End Sub

 

[Mentor82]

Hi,
You can also try this.

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sub DeleteNotBold()
    Dim headerColumn&
    Dim headerRow&
    Dim lastRow&
    Dim i&
    
    
    headerColumn = 1
    headerRow = 1
    
    lastRow = Cells(Rows.Count, headerColumn).End(xlUp).Row
    For i = lastRow To headerRow + 1 Step -1
        If Cells(i, headerColumn).Font.Bold = False And Cells(i, headerColumn).Offset(0, 1).Font.Bold = False Then
            Range(Cells(i, headerColumn), Cells(i, headerColumn).Offset(0, 1)).Delete
        End If
    Next i
    
End Sub[/FONT]

 

[JamesonMH]

You did not tell us what the range is nor the starting row for your data (excluding the header), so I guessed... change the red highlighted parts as needed...

Sub DeleteRowsIfAllCellsAreNotBold()
  Dim R As Long, StartRow As Long, EndRow As Long, DataCols As String
  DataCols = "[B][COLOR=#FF0000]D:E[/COLOR][/B]"
  StartRow = [B][COLOR=#FF0000]2[/COLOR][/B]
  EndRow = Cells(Rows.Count, Columns(DataCols).Resize(, 1).Column).End(xlUp).Row
  For R = StartRow To EndRow
    If Intersect(Rows(R), Columns(DataCols)).Font.Bold = False Then Intersect(Rows(R), Columns(DataCols)).Delete xlShiftUp
  Next
End Sub

Sorry about the range/column omission. This works perfectly - thanks very much Rick! Question, what would I tweak in that code if I ever needed to delete the entire row instead of only what we're deleting right now?

 

[JamesonMH]

Hi,
You can also try this.

[FONT=Verdana]Sub DeleteNotBold()
    Dim headerColumn&
    Dim headerRow&
    Dim lastRow&
    Dim i&
    
    
    headerColumn = 1
    headerRow = 1
    
    lastRow = Cells(Rows.Count, headerColumn).End(xlUp).Row
    For i = lastRow To headerRow + 1 Step -1
        If Cells(i, headerColumn).Font.Bold = False And Cells(i, headerColumn).Offset(0, 1).Font.Bold = False Then
            Range(Cells(i, headerColumn), Cells(i, headerColumn).Offset(0, 1)).Delete
        End If
    Next i
    
End Sub[/FONT]

Thanks for your reply Mentor82 - I'm going to work through your code this aft to understand it. I like how it's a different approach to Rick's solution. Perhaps I'll be able to use your technique in the future.

 

[JamesonMH]

https://www.extendoffice.com/documents/excel/3320-excel-delete-if-not-bold.html

Can you adapt that code?

Thanks James for that. I actually landed on that page (great website) earlier today when I first went looking for a solution. I found that code was a bit lengthy vs. what I was thinking the solution would end up being.

Cheers,
James

 

[Rick Rothstein]

Sub DeleteRowsIfAllCellsAreNotBold()
Dim R As Long, StartRow As Long, EndRow As Long, DataCols As String
DataCols = "D:E"
StartRow = 2
EndRow = Cells(Rows.Count, Columns(DataCols).Resize(, 1).Column).End(xlUp).Row
For R = StartRow To EndRow
If Intersect(Rows(R), Columns(DataCols)).Font.Bold = False Then Intersect(Rows(R), Columns(DataCols)).Delete xlShiftUp
Next
End SubSorry about the range/column omission. This works perfectly - thanks very much Rick! Question, what would I tweak in that code if I ever needed to delete the entire row instead of only what we're deleting right now?

Replace what I highlighted in red above to this...

Rows(R).Delete xlShiftUp

 

[JamesonMH]

Replace what I highlighted in red above to this...

Rows(R).Delete xlShiftUp

Got it. Thanks again Rick!

 

[Mentor82]

You're welcome!
With my approach you need to set first header column no which I set to 1, header row no which I also set to 1 and offset(0,1) which I set to one because I assume you have two columns. If you have more columns ex 4 change it to 3 etc.