Macro to highlight row based on cell match

dnorm

Board Regular
Joined
Dec 28, 2017
Messages
125
Office Version
  1. 365
Platform
  1. Windows
Hi All

Thanks for looking - I am after a macro o highlight a row in another sheet based on a date match.
i.e. today = X, look for X in Doc A B C D and highlight matching row/s.
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
.
Code:
Option Explicit


Sub Find_Data()
    Dim counter As Integer
    Dim currentSheet As Integer
    Dim notFound As Boolean
    Dim yesNo As String


    notFound = True


    On Error Resume Next
    currentSheet = ActiveSheet.Index
    datatoFind = StrConv(InputBox("Please enter the value to search for"), vbLowerCase)
    
    If datatoFind = "" Then Exit Sub
    sheetCount = ActiveWorkbook.Sheets.Count
    If IsError(CDbl(datatoFind)) = False Then datatoFind = CDbl(datatoFind)
    For counter = 1 To sheetCount
        Sheets(counter).Activate


        Cells.Find(What:=datatoFind, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate


        If InStr(1, StrConv(ActiveCell.Value, vbLowerCase), datatoFind) Then
            notFound = False
           
           ActiveCell.EntireRow.Interior.Color = vbYellow
            
        End If
    Next counter
    If notFound Then
        MsgBox ("Value not found")
        Sheets(currentSheet).Activate
    End If
End Sub


Private Function HasMoreValues(ByVal sheetCounter As Integer) As Boolean
    HasMoreValues = False
    Dim str As String
    Dim lastRow As Long
    Dim lastCol As Long
    Dim rRng  As Excel.Range
    Dim counter
    Dim vRow
    Dim vCol


    For counter = sheetCounter + 1 To sheetCount
        Sheets(counter).Activate


        lastRow = ActiveCell.SpecialCells(xlLastCell).Row
        lastCol = ActiveCell.SpecialCells(xlLastCell).Column


        For vRow = 1 To lastRow
            For vCol = 1 To lastCol
                str = Sheets(counter).Cells(vRow, vCol).Text
                If InStr(1, StrConv(str, vbLowerCase), datatoFind) Then
                    HasMoreValues = True
                    Exit For
                End If
            Next vCol


            If HasMoreValues Then
                Exit For
            End If
        Next vRow


        If HasMoreValues Then
            Sheets(sheetCounter).Activate
            Exit For
        End If
    Next counter
End Function
 
Upvote 0
Thank you, I have not had time to trial it yet due to my work load, but will feedback when I get chance.
 
Upvote 0

Forum statistics

Threads
1,213,531
Messages
6,114,167
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top