Find value in Range, Sheet or Sheets with VBA

Important message to visitors of this page

Ron de Bruin decided to remove all Windows Excel content from his website for personal reasons. If you want to know why, head over to rondebruin.nl.

Luckily, Ron was kind enough to allow me to publish all of his Excel content here.

Most of these pages are slightly outdated and may contain links that don 't work. Please inform me if you find such an error and I'll try to fix it.

Kind regards

Jan Karel Pieterse

Copy the code in a Standard module of your workbook, if you just started with VBA see this page.
Where do I paste the code that I find on the internet

Find is a very powerful option in Excel and is very useful. Together with the Offset function you can also change cells around the found cell. Below are a few basic examples that you can use to in your own code.

Use Find to select a cell

The examples below will search in column A of a sheet named "Sheet1" for the inputbox value. Change the sheet name or range in the code to your sheet/range.

Tip: You can replace the inputbox with a string or a reference to a cell like this
FindString = "SearchWord"
Or
FindString = Sheets("Sheet1").Range("D1").Value

This example will select the first cell in the range with the InputBox value.

Sub Find_First()
    Dim FindString As String
    Dim Rng As Range
    FindString = InputBox("Enter a Search value")
    If Trim(FindString) <> "" Then
        With Sheets("Sheet1").Range("A:A")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Application.Goto Rng, True
            Else
                MsgBox "Nothing found"
            End If
        End With
    End If
End Sub

If you have more then one occurrence of the value this will select the last occurrence.

Sub Find_Last()
    Dim FindString As String
    Dim Rng As Range
    FindString = InputBox("Enter a Search value")
    If Trim(FindString) <> "" Then
        With Sheets("Sheet1").Range("A:A")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(1), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Application.Goto Rng, True
            Else
                MsgBox "Nothing found"
            End If
        End With
    End If
End Sub

If you have date's in column A then this example will select the cell with today's date. Note : If your dates are formulas it is possible that you must change xlFormulas to xlValues in the example below. If your dates are values xlValues is not always working with some date formats.

Sub Find_Todays_Date()
    Dim FindString As Date
    Dim Rng As Range
    FindString = CLng(Date)
    With Sheets("Sheet1").Range("A:A")
        Set Rng = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlFormulas, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not Rng Is Nothing Then
            Application.Goto Rng, True
        Else
            MsgBox "Nothing found"
        End If
    End With
End Sub

Mark cells with the same value in column A in the B column

This example search in Sheets("Sheet1") in column A for every cell with "ron" and use Offset to mark the cell in the column to the right. Note: you can add more values to the array MyArr.

Sub Mark_cells_in_column()
    Dim FirstAddress As String
    Dim MyArr As Variant
    Dim Rng As Range
    Dim I As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Search for a Value Or Values in a range
    'You can also use more values like this Array("ron", "dave")
    MyArr = Array("ron")

    'Search Column or range
    With Sheets("Sheet1").Range("A:A")

        'clear the cells in the column to the right
        .Offset(0, 1).ClearContents

        For I = LBound(MyArr) To UBound(MyArr)

            'If you want to find a part of the rng.value then use xlPart
            'if you use LookIn:=xlValues it will also work with a
            'formula cell that evaluates to "ron"

            Set Rng = .Find(What:=MyArr(I), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)

            If Not Rng Is Nothing Then
                FirstAddress = Rng.Address
                Do
                    'mark the cell in the column to the right if "Ron" is found
                    Rng.Offset(0, 1).Value = "X"
                    Set Rng = .FindNext(Rng)
                Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
            End If
        Next I
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Color cells with the same value in a Range, worksheet or all worksheets

This example color all cells in the range Sheets("Sheet1").Range("B1:D100") with "ron". See the comments in the code if you want to use all cells on the worksheet. I use the color index in this example to give all cells with "ron" the color 3 (normal this is red)

See this site for all the 56 index numbers
http://dmcritchie.mvps.org/excel/colors.htm

Tip: For changing the Font color see the example lines below the macros.

Sub Color_cells_In_Range_Or_Sheet()
    Dim FirstAddress As String
    Dim MySearch As Variant
    Dim myColor As Variant
    Dim Rng As Range
    Dim I As Long

    'Fill in the search Value and color Index
    MySearch = Array("ron")
    myColor = Array("3")

    'You can also use more values in the Array
    'MySearch = Array("ron", "jelle", "judith")
    'myColor = Array("3", "6", "10")


    'Fill in the Search range, for the whole sheet use
    'you can use Sheets("Sheet1").Cells
    With Sheets("Sheet1").Range("B1:D100")

        'Change the fill color to "no fill" in all cells
        .Interior.ColorIndex = xlColorIndexNone

        For I = LBound(MySearch) To UBound(MySearch)

            'If you want to find a part of the rng.value then use xlPart
            'if you use LookIn:=xlValues it will also work with a
            'formula cell that evaluates to MySearch(I)
            Set Rng = .Find(What:=MySearch(I), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)

            If Not Rng Is Nothing Then
                FirstAddress = Rng.Address
                Do
                    Rng.Interior.ColorIndex = myColor(I)
                    Set Rng = .FindNext(Rng)
                Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
            End If
        Next I
    End With
End Sub

Example for all worksheets in the workbook

Sub Color_cells_In_All_Sheets()
    Dim FirstAddress As String
    Dim MySearch As Variant
    Dim myColor As Variant
    Dim Rng As Range
    Dim I As Long
    Dim sh As Worksheet

    'Fill in the search Value and color Index
    MySearch = Array("ron")
    myColor = Array("3")

    'You can also use more values in the Array
    'MySearch = Array("ron", "jelle", "judith")
    'myColor = Array("3", "6", "10")

    For Each sh In ActiveWorkbook.Worksheets

        'Fill in the Search range, for a range on each sheet
        'you can also use sh.Range("B1:D100")
        With sh.Cells

            'Change the fill color to "no fill" in all cells
            .Interior.ColorIndex = xlColorIndexNone

            For I = LBound(MySearch) To UBound(MySearch)

                'If you want to find a part of the rng.value then use xlPart
                'if you use LookIn:=xlValues it will also work with a
                'formula cell that evaluates to MySearch(I)
                Set Rng = .Find(What:=MySearch(I), _
                                After:=.Cells(.Cells.Count), _
                                LookIn:=xlFormulas, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)

                If Not Rng Is Nothing Then
                    FirstAddress = Rng.Address
                    Do
                        Rng.Interior.ColorIndex = myColor(I)
                        Set Rng = .FindNext(Rng)
                    Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
                End If
            Next I
        End With
    Next sh
End Sub

Change the Font color instead of the Interior color

Replace:

'Change the fill color to "no fill" in all cells
.Interior.ColorIndex = xlColorIndexNone

With

'Change the font in the column to Automatic
.Font.ColorIndex = 0

And Replace:

Rng.Interior.ColorIndex = myColor(I)
With
Rng.Font.ColorIndex = myColor(I)

Copy cells to another sheet with Find

The example below will copy all cells with a E-Mail Address in the range Sheets("Sheet1").Range("A1:E100") to a new worksheet in your workbook. Note: I use xlPart in the code instead of xlWhole to find each cell with a @ character.

Sub Copy_To_Another_Sheet_1()
    Dim FirstAddress As String
    Dim MyArr As Variant
    Dim Rng As Range
    Dim Rcount As Long
    Dim I As Long
    Dim NewSh As Worksheet

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Fill in the search Value
    MyArr = Array("@")

    'You can also use more values in the Array
    'myArr = Array("@", "www")

    'Add new worksheet to your workbook to copy to
    'You can also use a existing sheet like this
    'Set NewSh = Sheets("Sheet2")
    Set NewSh = Worksheets.Add

    With Sheets("Sheet1").Range("A1:Z100")

        Rcount = 0

        For I = LBound(MyArr) To UBound(MyArr)

            'If you use LookIn:=xlValues it will also work with a
            'formula cell that evaluates to "@"
            'Note : I use xlPart in this example and not xlWhole
            Set Rng = .Find(What:=MyArr(I), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                FirstAddress = Rng.Address
                Do
                    Rcount = Rcount + 1

                    Rng.Copy NewSh.Range("A" & Rcount)

                    ' Use this if you only want to copy the value
                    ' NewSh.Range("A" & Rcount).Value = Rng.Value

                    Set Rng = .FindNext(Rng)
                Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
            End If
        Next I
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

More Information

If you only want to replace values in your worksheet then you can use Replace manual (Ctrl+h) or use Replace in VBA. The code below replace ron for dave in the whole worksheet. Change xlPart to xlWhole if you only want to replace cells with only ron.

    ActiveSheet.Cells.Replace What:="ron", Replacement:="dave", LookAt:=xlPart, _
                              SearchOrder:=xlByRows, MatchCase:=False, _
                              SearchFormat:=False, ReplaceFormat:=False

See also Chip Pearson's site about the subject
http://www.cpearson.com/excel/FindAll.aspx

Ron de BruinExcel Automation