Results 1 to 8 of 8

Thread: Excel Find Method in Excel VBA (Any version of Excel)

  1. #1

    Thread Starter
    Discovering Life Siddharth Rout's Avatar
    Join Date
    Feb 2005
    Location
    Mumbai, India
    Posts
    12,001

    Excel Find Method in Excel VBA (Any version of Excel)

    I have been contemplating on writing this tutorial for a long time as I have found a lot of questions revolving around this topic. However due to the tight schedule that I am in, I was not getting the time for it. Surprisingly today I have no work and I am absolutely free. So the first thing that I did was open my pending work list (Old habits die hard) and saw that I had to write a tutorial on .Find so here it is…

    Most of us use loops in case we wanted to find something in Excel.

    For Example, Let’s say

    Our data is in sheet1 (Workbook Attached) from Cell A1 to A65000 and the data is like this

    A1 ~~> 1
    A2 ~~> 2
    A3 ~~> 3
    A4 ~~> 4
    A5 ~~> 5



    A65000 ~~> 65000
    Now suppose we want to find which cell has say 10000. The primitive way was to loop through each cell and find which cell had that value. For Example

    Code:
    Sub Sample()
        Dim oSht As Worksheet
        Dim lastRow As Long, i As Long
        Dim strSearch As String
        Dim t As Long
        
        t = GetTickCount
        
        On Error GoTo Err
        
        Set oSht = Sheets("Sheet1")
        
        lastRow = oSht.Range("A" & Rows.Count).End(xlUp).Row
        
        strSearch = "10000"
        
        For i = 1 To lastRow
            If oSht.Range("A" & i).Value = strSearch Then
                MsgBox "Value Found in Cell " & oSht.Range("A" & i).Address & vbCrLf & _
                "and it took " & GetTickCount - t & " milliseconds"
                Exit Sub
            End If
        Next i
      
        Exit Sub
    Err:
        MsgBox Err.Description
    End Sub
    This method of looping is not ‘wrong’ but yes it is very slow as compared to Excel’s inbuilt “.Find” Tool. The above sub executed in 109 milliseconds on my laptop.

    In this tutorial, I will stress on how to use .Find to make your search faster.

    The syntax of .Find is

    expression.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)

    Where

    Expression (Required): is any valid range Object. So if we take the above example then the range would be Range(“A1:A” & lastRow)
    What (Optional Variant): is the “Search value”
    After (Optional Variant): The cell after which you want the search to begin.
    LookIn (Optional Variant): The type of information. (xlValues or xlFormulas)
    LookAt (Optional Variant): Can be one of the following XlLookAt constants: xlWhole or xlPart.
    SearchOrder (Optional Variant): Can be one of the following XlSearchOrder constants: xlByRows or xlByColumns.
    SearchDirection: Can be one of these XlSearchDirection constants. xlNext default xlPrevious
    MatchCase (Optional Variant): True to make the search case sensitive. The default value is False.
    MatchByte (Optional Variant): Used only if you've selected or installed double-byte language support. True to have double-byte characters match only double-byte characters. False to have double-byte characters match their single-byte equivalents.
    SearchFormat (Optional Variant): The search format.

    Now let’s try and incorporate .Find to find the data that we want.

    Code:
    Sub Sample1()
        Dim oSht As Worksheet
        Dim lastRow As Long, i As Long
        Dim strSearch As String
        Dim t As Long
        Dim aCell As Range
        
        t = GetTickCount
        
        On Error GoTo Err
        
        Set oSht = Sheets("Sheet1")
        
        lastRow = oSht.Range("A" & Rows.Count).End(xlUp).Row
        
        strSearch = "10000"
        
        Set aCell = oSht.Range("A1:A" & lastRow).Find(What:=strSearch, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        If Not aCell Is Nothing Then
            MsgBox "Value Found in Cell " & aCell.Address & vbCrLf & _
            "and it took " & GetTickCount - t & "milliseconds"
        End If
        
        Exit Sub
    Err:
        MsgBox Err.Description
    End Sub
    The above sub took 6 milliseconds as compared to 109 milliseconds on the ‘looping’ sub !!!

    Let’s now take different scenarios on how to work with ".Find"

    The other scenarios that we will work on are as follows…

    1) Find Values in Cell Value (Covered above. Example in Sheet1)
    2) Find Values in Cell Formula (Example in Sheet2)
    3) .FindNext (Example in Sheet3)
    4) Making .Find work as Vlookup() formula (Example in Sheet4)

    If there are any other scenarios that you are finding difficulty with then simply create a new thread in Office Development and I will try to help you if I can
    Attached Files Attached Files
    Last edited by Siddharth Rout; Dec 4th, 2010 at 07:28 AM.
    A good exercise for the Heart is to bend down and help another up...
    Please Mark your Thread "Resolved", if the query is solved


    MyGear:
    ★ CPU ★ Ryzen 5 5800X
    ★ GPU ★ NVIDIA GeForce RTX 3080 TI Founder Edition
    ★ RAM ★ G. Skill Trident Z RGB 32GB 3600MHz
    ★ MB ★ ASUS TUF GAMING X570 (WI-FI) ATX Gaming
    ★ Storage ★ SSD SB-ROCKET-1TB + SEAGATE 2TB Barracuda IHD
    ★ Cooling ★ NOCTUA NH-D15 CHROMAX BLACK 140mm + 10 of Noctua NF-F12 PWM
    ★ PSU ★ ANTEC HCG-1000-EXTREME 1000 Watt 80 Plus Gold Fully Modular PSU
    ★ Case ★ LIAN LI PC-O11 DYNAMIC XL ROG (BLACK) (G99.O11DXL-X)
    ★ Monitor ★ LG Ultragear 27" 240Hz Gaming Monitor
    ★ Keyboard ★ TVS Electronics Gold Keyboard
    ★ Mouse ★ Logitech G502 Hero

  2. #2

    Thread Starter
    Discovering Life Siddharth Rout's Avatar
    Join Date
    Feb 2005
    Location
    Mumbai, India
    Posts
    12,001

    Find Values in Cell Formula (Example in Sheet2)

    Scenario 2

    Find Values in Cell Formula (Example in Sheet2)

    Let’s say our data is as follows

    B1 ~~> 1
    B2 ~~> 2
    B3 ~~> 3
    B4 ~~> 4
    B5 ~~> 5



    B100 ~~> 100

    And This

    C1 ~~> 1
    C2 ~~> 2
    C3 ~~> 3
    C4 ~~> 4
    C5 ~~> 5



    C100 ~~> 100

    And Finally This

    A1 ~~> =SUM(B1:C1)
    A2 ~~> =SUM(B2:C2)
    A3 ~~> =SUM(B3:C3)
    A4 ~~> =SUM(B4:C4)
    A5 ~~> =SUM(B5:C5)


    A27~~> =MAX(B5:C5)

    A100 ~~> =SUM(B2:C2)
    Now I want to Find the word “MAX” in the formula and replace it with say “SUM” so using .Find we can achieve it in the following manner.

    Note that since we are searching for values in the formula then LookIn takes the value of xlFormulas

    Code:
    Sub Sample2()
        Dim oSht As Worksheet
        Dim lastRow As Long, i As Long
        Dim strSearch As String
        Dim aCell As Range
        
        On Error GoTo Err
        
        Set oSht = Sheets("Sheet2")
        
        lastRow = oSht.Range("A" & Rows.Count).End(xlUp).Row
        
        strSearch = "MAX"
        
        Set aCell = oSht.Range("A1:A" & lastRow).Find(What:=strSearch, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        If Not aCell Is Nothing Then
            MsgBox "A"
            aCell.Formula = Replace(aCell.Formula, strSearch, "SUM")
        End If
        
        Exit Sub
    Err:
        MsgBox Err.Description
    End Sub
    A good exercise for the Heart is to bend down and help another up...
    Please Mark your Thread "Resolved", if the query is solved


    MyGear:
    ★ CPU ★ Ryzen 5 5800X
    ★ GPU ★ NVIDIA GeForce RTX 3080 TI Founder Edition
    ★ RAM ★ G. Skill Trident Z RGB 32GB 3600MHz
    ★ MB ★ ASUS TUF GAMING X570 (WI-FI) ATX Gaming
    ★ Storage ★ SSD SB-ROCKET-1TB + SEAGATE 2TB Barracuda IHD
    ★ Cooling ★ NOCTUA NH-D15 CHROMAX BLACK 140mm + 10 of Noctua NF-F12 PWM
    ★ PSU ★ ANTEC HCG-1000-EXTREME 1000 Watt 80 Plus Gold Fully Modular PSU
    ★ Case ★ LIAN LI PC-O11 DYNAMIC XL ROG (BLACK) (G99.O11DXL-X)
    ★ Monitor ★ LG Ultragear 27" 240Hz Gaming Monitor
    ★ Keyboard ★ TVS Electronics Gold Keyboard
    ★ Mouse ★ Logitech G502 Hero

  3. #3

    Thread Starter
    Discovering Life Siddharth Rout's Avatar
    Join Date
    Feb 2005
    Location
    Mumbai, India
    Posts
    12,001

    .FindNext (Example in Sheet3)

    Scenario 3

    .FindNext (Example in Sheet3)

    Let’s say our data is as follows
    A1 ~~> 1
    A2 ~~> 2
    A3 ~~> 3
    A4 ~~> 4
    A5 ~~> 5


    A27~~> 2


    A45~~> 2


    A100 ~~> 100
    If you have noticed that Cell A2, A27, A45 has the same value which is 2

    So if I want to find all "2" 's one after the other then how do I do that using .Find. It is very simple. We use .FindNext in a loop.

    See example below.

    Code:
    Sub Sample()
        Dim oRange As Range, aCell As Range, bCell As Range
        Dim ws As Worksheet
        Dim ExitLoop As Boolean
        Dim SearchString As String, FoundAt As String
        
        On Error GoTo Err
        
        Set ws = Worksheets("Sheet3")
        Set oRange = ws.Columns(1)
    
        SearchString = "2"
        
        Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _
                    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)
        
        If Not aCell Is Nothing Then
            Set bCell = aCell
            FoundAt = aCell.Address
            Do While ExitLoop = False
                Set aCell = oRange.FindNext(After:=aCell)
    
                If Not aCell Is Nothing Then
                    If aCell.Address = bCell.Address Then Exit Do
                    FoundAt = FoundAt & ", " & aCell.Address
                Else
                    ExitLoop = True
                End If
            Loop
        Else
            MsgBox SearchString & " not Found"
        End If
        
        MsgBox "The Search String has been found these locations: " & FoundAt
        Exit Sub
    Err:
        MsgBox Err.Description
    End Sub
    Last edited by Siddharth Rout; Dec 6th, 2010 at 05:23 PM. Reason: typo
    A good exercise for the Heart is to bend down and help another up...
    Please Mark your Thread "Resolved", if the query is solved


    MyGear:
    ★ CPU ★ Ryzen 5 5800X
    ★ GPU ★ NVIDIA GeForce RTX 3080 TI Founder Edition
    ★ RAM ★ G. Skill Trident Z RGB 32GB 3600MHz
    ★ MB ★ ASUS TUF GAMING X570 (WI-FI) ATX Gaming
    ★ Storage ★ SSD SB-ROCKET-1TB + SEAGATE 2TB Barracuda IHD
    ★ Cooling ★ NOCTUA NH-D15 CHROMAX BLACK 140mm + 10 of Noctua NF-F12 PWM
    ★ PSU ★ ANTEC HCG-1000-EXTREME 1000 Watt 80 Plus Gold Fully Modular PSU
    ★ Case ★ LIAN LI PC-O11 DYNAMIC XL ROG (BLACK) (G99.O11DXL-X)
    ★ Monitor ★ LG Ultragear 27" 240Hz Gaming Monitor
    ★ Keyboard ★ TVS Electronics Gold Keyboard
    ★ Mouse ★ Logitech G502 Hero

  4. #4

    Thread Starter
    Discovering Life Siddharth Rout's Avatar
    Join Date
    Feb 2005
    Location
    Mumbai, India
    Posts
    12,001

    Making .Find work as Vlookup() formula (Example in Sheet4)

    Scenario 4

    Making .Find work as Vlookup() formula (Example in Sheet4)

    Lets Say we have a database (see picture attached) and a range where data needs to be updated (see picture attached)

    Now suppose we have to find the capitals for the relevant companies then we can use .Find() to get the relevant companies

    For Example

    Code:
    Sub Sample()
        Dim ws As Worksheet
        Dim DataRange As Range, UpdateRange As Range, aCell As Range, bCell As Range
        
        On Error GoTo Err
        
        Set ws = Worksheets("Sheet4")
        Set UpdateRange = ws.Range("B5:B16")
        Set DataRange = ws.Range("J5:J16")
        
        For Each aCell In UpdateRange
            Set bCell = DataRange.Find(What:=aCell, LookIn:=xlValues, _
                        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)
        
            If Not aCell Is Nothing Then
                aCell.Offset(, 1) = bCell.Offset(, 1)
            End If
        Next
        
        Exit Sub
    Err:
        MsgBox Err.Description
    End Sub
    Attached Images Attached Images  
    A good exercise for the Heart is to bend down and help another up...
    Please Mark your Thread "Resolved", if the query is solved


    MyGear:
    ★ CPU ★ Ryzen 5 5800X
    ★ GPU ★ NVIDIA GeForce RTX 3080 TI Founder Edition
    ★ RAM ★ G. Skill Trident Z RGB 32GB 3600MHz
    ★ MB ★ ASUS TUF GAMING X570 (WI-FI) ATX Gaming
    ★ Storage ★ SSD SB-ROCKET-1TB + SEAGATE 2TB Barracuda IHD
    ★ Cooling ★ NOCTUA NH-D15 CHROMAX BLACK 140mm + 10 of Noctua NF-F12 PWM
    ★ PSU ★ ANTEC HCG-1000-EXTREME 1000 Watt 80 Plus Gold Fully Modular PSU
    ★ Case ★ LIAN LI PC-O11 DYNAMIC XL ROG (BLACK) (G99.O11DXL-X)
    ★ Monitor ★ LG Ultragear 27" 240Hz Gaming Monitor
    ★ Keyboard ★ TVS Electronics Gold Keyboard
    ★ Mouse ★ Logitech G502 Hero

  5. #5
    VB Addict Pradeep1210's Avatar
    Join Date
    Apr 2004
    Location
    Inside the CPU...
    Posts
    6,614

    Re: Excel Find Method in Excel VBA (Any version of Excel)

    Nice tutorial
    Pradeep, Microsoft MVP (Visual Basic)
    Please appreciate posts that have helped you by clicking icon on the left of the post.
    "A problem well stated is a problem half solved." — Charles F. Kettering

    Read articles on My Blog101 LINQ SamplesJSON ValidatorXML Schema Validator"How Do I" videos on MSDNVB.NET and C# ComparisonGood Coding PracticesVBForums Reputation SaverString EnumSuper Simple Tetris Game


    (2010-2013)
    NB: I do not answer coding questions via PM. If you want my help, then make a post and PM me it's link. If I can help, trust me I will...

  6. #6
    New Member
    Join Date
    Apr 2012
    Posts
    8

    Re: Excel Find Method in Excel VBA (Any version of Excel)

    Here is a subroutine that can be used to find the last cell in a sheet that contains a string.

    First, make it similar to the Ctrl-F (excel default find), but more simple
    Second, adjust the where about to be in the center (sort of) on the screen of the cell found!

    Note: if not found, do nothing, that can be improve!

    Code:
    Sub FindLast()
        Static sWhat
        sWhat = InputBox("Find What:", "FIND LAST", sWhat)
        If sWhat <> "" Then
            Dim rFound As Range
            
            On Error Resume Next
            Set rFound = Cells.Find(What:=sWhat, _
                After:=Cells(Cells.Rows.Count, Cells.Columns.Count), _
                LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
            On Error GoTo 0
            
            If Not rFound Is Nothing Then
                ' MsgBox rFound.Row & " " & rFound.Column
                iRowOffset = 10
                rFound.Offset(iRowOffset, 0).Select
                If rFound.Row <= iRowOffset Then iRowOffset = rFound.Row - 1
                rFound.Offset(-iRowOffset, 0).Select
                iColOffset = 4
                rFound.Offset(0, iColOffset).Select
                If rFound.Column <= iColOffset Then iColOffset = rFound.Column - 1
                rFound.Offset(0, -iColOffset).Select
                rFound.Select
                
                ' sYesNo = InputBox("Copy the last month 3 columns ? (Y)", "COPY LAST MONTH")
                ' If sYesNo = "y" Or sYesNo = "Y" Then
                '    Range(rFound.Offset(0, -2), rFound.Offset(0, 0)).Select
                '    Application.Selection.Copy
                '    rFound.Offset(0, 1).Select
                '    Application.ActiveSheet.Paste
                '    rFound.Offset(0, 1).Select
                '    Application.CutCopyMode = False
                ' End If
            End If
        End If
    End Sub
    Last edited by manandpc; Jul 13th, 2012 at 11:12 AM.

  7. #7
    New Member
    Join Date
    Dec 2012
    Posts
    1

    Re: Excel Find Method in Excel VBA (Any version of Excel)

    Hi koolsid,

    Good tool.
    Could you help me with (1) adding deletion of the rows that where found by .find and (2) find and list of about 50 values (and later delete the rows)?

    Foer (1) I used scenario 3 and replaced the "MsgBox "The Search String has been found these locations: " & FoundAt" by "Range(FoundAt).EntireRow.Delete".
    This worked find for some hits but "Range" reported an error for a long string for "FoundAt" (e.g. 70).

    I would apprecitate any help on this.

  8. #8
    New Member
    Join Date
    Feb 2014
    Posts
    1

    Re: Excel Find Method in Excel VBA (Any version of Excel)

    Hi Siddharth,
    Right now I am using below macro to replace values in my large data. But the problem is, The replace or replaced values are changing with every data set and if required value not found the macro give error. Can anyone help me, how I use IF condition with Cells.replace. For example IF D found then run this block of code otherwise jump to next value.

    Sub ReplaceAll()

    Application.ScreenUpdating = False

    Sheets("Data").Select
    Range("A1").Select

    Cells.replace what:="D", Replacement:="", LookAt:=xlPart, SearchOrder:= _
    xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

    Cells.replace what:="F", Replacement:="", LookAt:=xlPart, SearchOrder:= _
    xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

    Application.ScreenUpdating = True

    End Sub
    Any help will be appreciated

    Thanks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width