Color the cells that contain a value in a specific row

[sofas]

Hello, I want to search in row No. 2 of the worksheet, and when a cell with a value is found, the background of the cell is colored yellow and the empty cells are ignored.

 

[Trebor76]

Hi sofas,

Try this:

Option Explicit
Sub Macro1()

    'https://www.mrexcel.com/board/threads/color-the-cells-that-contain-a-value-in-a-specific-row.1258162

    Dim ws As Worksheet
    Dim rngFound As Range
    Dim strFirstAddress As String, strMyText As String
    
    Application.ScreenUpdating = False
    
    strMyText = "Hello World!!" 'Text to be highlighted. Change to suit.
    
    Set ws = ThisWorkbook.Sheets(CStr("Sheet1")) 'Sheet name with the data in Row 2 to be checked. Change to suit.
        Set rngFound = ws.Rows("2:2").Find(What:=strMyText, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlRows, SearchDirection:=xlNext, MatchCase:=False)
        If Not rngFound Is Nothing Then
            rngFound.Interior.Color = RGB(255, 255, 0)
            strFirstAddress = rngFound.Address
            Do
                Set rngFound = ws.Rows("2:2").FindNext(rngFound)
                rngFound.Interior.Color = RGB(255, 255, 0)
            Loop While Not rngFound Is Nothing And rngFound.Address <> strFirstAddress
        End If
    Set rngFound = Nothing
    
    Application.ScreenUpdating = True
    
End Sub

Regards,

Robert

 

[sofas]

Hi sofas,

Try this:

Option Explicit
Sub Macro1()

    'https://www.mrexcel.com/board/threads/color-the-cells-that-contain-a-value-in-a-specific-row.1258162

    Dim ws As Worksheet
    Dim rngFound As Range
    Dim strFirstAddress As String, strMyText As String
   
    Application.ScreenUpdating = False
   
    strMyText = "Hello World!!" 'Text to be highlighted. Change to suit.
   
    Set ws = ThisWorkbook.Sheets(CStr("Sheet1")) 'Sheet name with the data in Row 2 to be checked. Change to suit.
        Set rngFound = ws.Rows("2:2").Find(What:=strMyText, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlRows, SearchDirection:=xlNext, MatchCase:=False)
        If Not rngFound Is Nothing Then
            rngFound.Interior.Color = RGB(255, 255, 0)
            strFirstAddress = rngFound.Address
            Do
                Set rngFound = ws.Rows("2:2").FindNext(rngFound)
                rngFound.Interior.Color = RGB(255, 255, 0)
            Loop While Not rngFound Is Nothing And rngFound.Address <> strFirstAddress
        End If
    Set rngFound = Nothing
   
    Application.ScreenUpdating = True
   
End Sub

Regards,

Robert

Thanks, I tried the code works well, but I don't have a specific number or word to search. What I want is to color any cell with a value and ignore the empty along row 2

 

[Trebor76]

What I want is to color any cell with a value and ignore the empty along row 2

Try this:

Option Explicit
Sub Macro2()

    'https://www.mrexcel.com/board/threads/color-the-cells-that-contain-a-value-in-a-specific-row.1258162

    Dim ws As Worksheet
    Dim rngFound As Range
    Dim strFirstAddress As String
   
    Application.ScreenUpdating = False
   
    Set ws = ThisWorkbook.Sheets(CStr("Sheet1")) 'Sheet name with the data in Row 2 to be checked. Change to suit.
        Set rngFound = ws.Rows("2:2").Find(What:="*", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlRows, SearchDirection:=xlNext, MatchCase:=False)
        If Not rngFound Is Nothing Then
            rngFound.Interior.Color = RGB(255, 255, 0)
            strFirstAddress = rngFound.Address
            Do
                Set rngFound = ws.Rows("2:2").FindNext(rngFound)
                rngFound.Interior.Color = RGB(255, 255, 0)
            Loop While Not rngFound Is Nothing And rngFound.Address <> strFirstAddress
        End If
        Set rngFound = Nothing
    Set ws = Nothing
   
    Application.ScreenUpdating = True
   
End Sub

 

[sofas]

Try this:

Option Explicit
Sub Macro2()

    'https://www.mrexcel.com/board/threads/color-the-cells-that-contain-a-value-in-a-specific-row.1258162

    Dim ws As Worksheet
    Dim rngFound As Range
    Dim strFirstAddress As String
  
    Application.ScreenUpdating = False
  
    Set ws = ThisWorkbook.Sheets(CStr("Sheet1")) 'Sheet name with the data in Row 2 to be checked. Change to suit.
        Set rngFound = ws.Rows("2:2").Find(What:="*", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlRows, SearchDirection:=xlNext, MatchCase:=False)
        If Not rngFound Is Nothing Then
            rngFound.Interior.Color = RGB(255, 255, 0)
            strFirstAddress = rngFound.Address
            Do
                Set rngFound = ws.Rows("2:2").FindNext(rngFound)
                rngFound.Interior.Color = RGB(255, 255, 0)
            Loop While Not rngFound Is Nothing And rngFound.Address <> strFirstAddress
        End If
        Set rngFound = Nothing
    Set ws = Nothing
  
    Application.ScreenUpdating = True
  
End Sub

Thank you very much I appreciate your help

 

[Trebor76]

Thank you very much I appreciate your help

You're welcome