VBA Find unbold data

[sksanjeev786]

Hi Team,

I have data in which green, Blue shaded data should be in Bold and grey shaded should be in unbold

but in below data while doing manual bold and unbold some greeen shadded coloer bold is miss

so i want to find out where ever i have miss bold

Book1
	B	C	D	E	F	G
2	41%	16.1	43%	15.3	63%	8.7
3
4	39%	15.2	39%	4.2	49%	20.2
5	45%	20.4	45%	6.5	64%	12.9
6
7	93%	0.9	90%	4.4	95%	-4.1
8	36%	13.9	37%	12.5	49%	20.5
9	12%	12.1	12%	22.2	27%	6.4
10	44%	14.2	44%	15.1	61%	12.9
11	162/881		168/819		106/288
Sheet1

 

[sksanjeev786]

You are welcome.
I don't really understand your question about borders.
If you want to check cells which is not bold by border color. For that you can just replace cell.Interior.Color with cell.Border.Color
But also, you will need replace RGB code with color code of borders.

Hi

No i meant now we are getting output in Msg box where ever we don't have bold data in cell instead of that can we have a border on cell as as output
like if no bold on cell i need as a Cell border to identify easily in once view

same i have kept in images for ref..

 

[Akbarov]

Try this

Sub is_BOLD()
Dim wb As Workbook
Dim ws As Worksheet
Dim rg As Range

Set ws = ActiveSheet
Set rg = ws.Range("B1:B10")

For Each cell In rg
If cell.Font.Bold = False And _
cell.Interior.Color = RGB(150, 193, 29) Then

    With cell.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With cell.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With cell.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With cell.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With

ElseIf cell.Font.Bold = False And _
cell.Interior.Color = RGB(14, 173, 195) Then

    With cell.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With cell.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With cell.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With cell.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
End If

Next
End Sub

Don't forget to edit range: ws.Range("B1:B10")

 

[sksanjeev786]

Try this

Sub is_BOLD()
Dim wb As Workbook
Dim ws As Worksheet
Dim rg As Range

Set ws = ActiveSheet
Set rg = ws.Range("B1:B10")

For Each cell In rg
If cell.Font.Bold = False And _
cell.Interior.Color = RGB(150, 193, 29) Then

    With cell.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With cell.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With cell.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With cell.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With

ElseIf cell.Font.Bold = False And _
cell.Interior.Color = RGB(14, 173, 195) Then

    With cell.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With cell.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With cell.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With cell.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
End If

Next
End Sub

Don't forget to edit range: ws.Range("B1:B10")

Perfect...

thank you so much for your valuable time on this..

this made my day..!!!

 

[Akbarov]

You are welcome. You can use this to check all columns at once. Change 20 to last column.

Sub is_BOLD()
Dim wb As Workbook
Dim ws As Worksheet
Dim rg As Range
Dim i As Long

For i = 2 To 20 Step 2 '20 is number of last column
Set ws = ActiveSheet
Set rg = ws.Range(Cells(1, i), Cells(100, i))

For Each cell In rg
If cell.Font.Bold = False And _
cell.Interior.Color = RGB(150, 193, 29) Then

    With cell.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With cell.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With cell.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With cell.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With

ElseIf cell.Font.Bold = False And _
cell.Interior.Color = RGB(14, 173, 195) Then

    With cell.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With cell.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With cell.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With cell.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
End If

Next
Next i
End Sub