When is black not blan

[reitsmad]

I have written code to highlight any word found in a cell from a list. eg. Look for the word "BUBBLE" in a search range and if found then change the color of "BUBBLE" to vbRed and put the number 1 in the next cell over. I then go through another list to check for false positives, eg. Look for "NO BUBBLE" in the same search range. If "NO BUBBLE" is found then change the color of "NO BUBBLE" to vbBlack.

After going through the false positives list I then run a sub routine call FalsePositives to check if the cell color in the search range is vbBlack because I don't want them displayed. Since in the above example "BUBBLE" which was vbRed has now been changed to vbBlack when "NO BUBBLE" was found I just go back through the cells and check to see if they are vbBlack now and then remove the 1's from the offset cells. When I physically look at the cell it is indeed vbBlack - RGB(0,0,0) but according to VB is it not so the offset values are not changed to "". I have tried to check the color of the cell by using font.color but shows blank rather than 0, which is what shows up for a cell that has not been changed. It seems to me that this is a bug in VB, but maybe my logic is just wrong. I am hoping someone can recommend a better way.

'HIGH search valuesFndRows = Range("A2", Range("A2").End(xlDown)).Rows.Count
Range("A2").Select
For x = 1 To FndRows  'Go through the list of values to search
    oStrg = ActiveCell.Value
    On Error Resume Next
    For Each cl In SrchRng
        If InStr(1, cl.Value, oStrg, vbTextCompare) > 0 Then
            cl.Offset(0, 1).Value = 1 'Mark it as found
            cl.Offset(0, 2).Value = 1 'Mark it as HIGH
        End If
        fndTxt = InStr(1, cl, oStrg, vbTextCompare)
        Do Until fndTxt = 0
            With cl.Characters(fndTxt, Len(oStrg))
                .Font.Color = vbRed 'RGB(255, 0, 0)
                .Font.Bold = True
            End With
            fndTxt = InStr(fndTxt + 1, cl, oStrg, vbTextCompare)
        Loop
    Next cl
    ActiveCell.Offset(1, 0).Select
Next


'Turn off highlighted search values that are false positives
FndRows = Range("E2", Range("E2").End(xlDown)).Rows.Count
Range("E2").Select
For x = 1 To FndRows  'Go through the list of values to search
    oStrg = ActiveCell.Value
    On Error Resume Next
    For Each cl In SrchRng
         If InStr(1, cl.Value, oStrg, vbTextCompare) > 0 Then 'Found a false positive
                cl.Offset(0, 6).Value = 1 'Mark false positive found
                fndTxt = InStr(1, cl, oStrg, vbTextCompare)
                Do Until fndTxt = 0
                    With cl.Characters(fndTxt, Len(oStrg))
                        .Font.Color = vbBlack
                        .Font.Bold = False
                    End With
                    fndTxt = InStr(fndTxt + 1, cl, oStrg, vbTextCompare)
                Loop
          End If
    Next cl
    ActiveCell.Offset(1, 0).Select
Next

Call FalsePositives



Sub FalsePositives()


ws.Target.Activate
' Turn off false positive cells - they only have black font color.
FndRows = Range("F5", Range("F5").End(xlDown)).Rows.Count
Range("F5").Select
For x = 1 To FndRows  'Go through the list of values to search
    If ActiveCell.Offset(0, 6).Value = 1 Then 'Highlighted as having a false positive
        If ActiveCell.Font.Color = vbBlack Then
            'ActiveCell.Offset(0, 1).Value = ""
            'ActiveCell.Offset(0, 2).Value = ""
        End If
    End If
    ActiveCell.Offset(1, 0).Select
Next




End Sub

 

[reitsmad]

Re: When is black not black

The point was that I was trying to work out if you were evaluating the correct cell, in other words making sure that the correct sheet had been activated.

So no you didn't provide too much information, rather too little.

On a different track, if you select the cell what does the code below produce.

Sub RGB_Font()
    Dim HxCol As String, RGBcol As String

    HxCol = Right("000000" & Hex(ActiveCell.Font.Color), 6)

    RGBcol = "RGB (" & CInt("&H" & Right(HxCol, 2)) & _
             ", " & CInt("&H" & Mid(HxCol, 3, 2)) & _
             ", " & CInt("&H" & Left(HxCol, 2)) & ")"

    MsgBox RGBcol, vbInformation, "Cell " & ActiveCell.Address(0, 0) & ":  Fill Color"

End Sub

I see. Yes, all searching in the right place. Simple matter to use the same code for highlighting and false positive by just changing the color to black and bold to false. That part has always worked fine. I ran your code on a cell that looks all black - it shows RGB(0,0,0) but I got the same from a cell with a word in red and bold.

I did the following which shows the false positive string is not black...

Range("F5").Select
ActiveCell.FormulaR1C1 = "THIS IS THE FALSE POSITIVE TEST CELL."
With ActiveCell.Characters(Start:=1, Length:=12).Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With ActiveCell.Characters(Start:=13, Length:=14).Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -16777216 'THIS SHOULD BE BLACK!!!
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With ActiveCell.Characters(Start:=27, Length:=11).Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With

A cell that was not changed looks like this...
Range("F6").Select
ActiveCell.FormulaR1C1 = "NOTHING CHANGED TEST"
Range("F7").Select

I have fixed the problem now by changing all cells to be searched to black before running the filters and false positive checks. I hasten to add I have no idea why since it already looked black to me!

'Make data all black
Range("F5").Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Font
.Color = vbBlack
.Bold = False
End With
Range("F5").Select

Cell F5 now looks like the nothing changed cell.

Range("F5").Select
ActiveCell.FormulaR1C1 = "THIS IS THE FALSE POSITIVE TEST CELL."


Thanks!

 

[MARK858]

Re: When is black not black

Happy you found a workaround but a bit surprised you get 0,0,0 with a red bold font with the code I gave you as I get 255,0,0

 

[reitsmad]

Re: When is black not black

Happy you found a workaround but a bit surprised you get 0,0,0 with a red bold font with the code I gave you as I get 255,0,0

Thanks. I get RGB(255,0,0) if the characters are all red but RGB(0,0,0) if there is more than one color. When I search for a value it highlights all the words / phrases found in the cell. I have HIGH MEDIUM LOW search criteria so sometimes there are 4 different colors in the cell.

This is what I get when I run a color code and when I run your routine.

Color	Color Code	Your RGB
BLACK	0	0,0,0
GREEN	5287936	0,176,80
RED	255	255,0,0
RED BLACK		0,0,0

<colgroup><col><col><col></colgroup><tbody>
</tbody>

 

[MARK858]

Re: When is black not black

Can the black text be anywhere in the cell?

 

[reitsmad]

Re: When is black not black

Can the black text be anywhere in the cell?

Yes. The data is free form comments so I have no idea where the values I am searching for will be.

 

[MARK858]

Re: When is black not black

At the moment the only way I can think of is to loop through the characters, i.e. for one cell something like...

Sub RGB_Fill()
    Dim HxCol As String, RGBcol As String, i As Long
    For i = 1 To Len(ActiveCell)
    
        HxCol = Right("000000" & Hex(ActiveCell.Characters(i, 1).Font.Color), 6)

        RGBcol = "RGB (" & CInt("&H" & Right(HxCol, 2)) & _
                 ", " & CInt("&H" & Mid(HxCol, 3, 2)) & _
                 ", " & CInt("&H" & Left(HxCol, 2)) & ")"

        If RGBcol = "RGB (255, 0, 0)" Then
            MsgBox RGBcol, vbInformation, "Cell " & ActiveCell.Address(0, 0) & ":  Fill Color"
            Exit Sub
        End If

    Next
End Sub

I have put the above code as searching for red so you can distinguish from the 0,0,0

 

[reitsmad]

Re: When is black not black

Thanks MARK858.

I have streamlined my code to find the false positives and if all characters are then back to all black in the cell it removes the offset indicators which are used for filtering all cells that are highlighted, HIGH, MEDIUM, LOW or OTHER as I have designated in various search value lists.

'Turn off highlighted search values that are false positives
FndRows = Range("E2", Range("E2").End(xlDown)).Rows.Count
Range("E2").Select
For x = 1 To FndRows  'Go through the list of values to search
    oStrg = ActiveCell.Value
    On Error Resume Next
    For Each cl In SrchRng
        If cl.Offset(0, 1) = 1 Then                                 'Only do a cell with a highlight in it.
            If InStr(1, cl.Value, oStrg, vbTextCompare) > 0 Then    'False positive found.
                cl.Offset(0, 6).Value = 1                           'add a value so I can see which one it was.
            End If
            fndTxt = InStr(1, cl, oStrg, vbTextCompare)
            Do Until fndTxt = 0
                With cl.Characters(fndTxt, Len(oStrg))
                    .Font.Color = vbBlack
                    .Font.Bold = False
                End With
                fndTxt = InStr(fndTxt + 1, cl, oStrg, vbTextCompare)
            Loop
            If cl.Font.Color = vbBlack Then                           'All of the highlights have been changed to black and cell is a complete false positive.
                cl.Offset(0, 1).Value = ""
                cl.Offset(0, 2).Value = ""
                cl.Offset(0, 3).Value = ""
                cl.Offset(0, 4).Value = ""
                cl.Offset(0, 5).Value = ""
                cl.Offset(0, 6).Value = cl.Font.Color                 'change the false poitive indicator to 0 to show that the cell is a complete flase positive.
            End If
        End If
    Next cl
    ActiveCell.Offset(1, 0).Select
Next