Results 1 to 7 of 7

Thread: Highlighting All the Cells of Active sheet which contains a particular String:

  1. #1
    Member littleiitin's Avatar
    Join Date
    Aug 2011
    Posts
    90
    Rep Power
    14

    Highlighting All the Cells of Active sheet which contains a particular String:

    If You want to find any string in whole sheet then Give a try to Below Code:


    Code:
    Sub SelectXCells(strSearch As String)
    
        Dim rngWhole     As Range
        Dim rngUni      As Range
        Dim lngRow      As Long
        Dim lngCol      As Long
        Dim rngCell     As Range
        
        Set rngWhole = ActiveSheet.UsedRange
        For Each rngCell In rngWhole
            If InStr(1, rngCell, strSearch, vbTextCompare) > 0 Then
                If rngUni Is Nothing Then
                    Set rngUni = rngCell
                Else
                    Set rngUni = Union(rngUni, rngCell)
                End If
            End If
        Next rngCell
        On Error Resume Next
        rngUni.Select
        On Error GoTo 0
    End Sub
    Example:
    Code:
    Sub Test()
    
        Dim strFind As String
        
        strFind = InputBox("Please enter string to find", "Find String in Used Range")
        SelectXCells (strFind)
    End Sub
    Last edited by littleiitin; 11-27-2011 at 10:56 AM.

  2. #2
    Senior Member
    Join Date
    Apr 2011
    Posts
    190
    Rep Power
    14
    Littleiitin
    Below is what I use - I am just posting it as an alternative - I have no idea if one method is faster than the other.

    The code below is what I use to read my default settings (settings selected by the user last time he ran the program) - so that is why the ColDefault has 2 added - so I actually read the last setting for the that variable into ReadValue.

    I have all my messages in a module - so just rem out that call to message106

    Thanks
    Rasm

    Code:
    Public Sub ReadDefault(ValueToFind, ColDefault, RowDefault, ReadValue)
        Dim RangeVal As String
        Dim FoundCell As Range
        Dim LastCell As Range
        Dim LastRow As Long
        Dim ColLast As Long
        With ThisWorkbook.Worksheets("Default_Settings_01").UsedRange
            LastRow = .Rows(.Rows.Count).Row
            ColLast = .Columns(.Columns.Count).Column
        End With
        With ThisWorkbook.Worksheets("Default_Settings_01")
            RangeVal = "A1:" & Split(Cells(1, ColLast).Address, "$")(1) & LastRow
            With .Range(RangeVal)
                Set LastCell = .Cells(.Cells.Count)
            End With
            Astr = ValueToFind
            RangeVal = "A1:" & Split(Cells(1, ColLast).Address, "$")(1) & LastRow
            With .Range(RangeVal)
                Set LastCell = .Cells(.Cells.Count)
            End With
            Set FoundCell = .Range(RangeVal).Find(What:=(Astr), after:=LastCell)
            If FoundCell Is Nothing Then
                    Astr = ValueToFind                
                    Call Message106(Astr)                
                Else
                    ColDefault = FoundCell.Column + 2
                    RowDefault = FoundCell.Row
                    ReadValue = .Cells(FoundCell.Row, FoundCell.Column + 2)
            End If
        End With
    End Sub
    Last edited by Rasm; 11-27-2011 at 01:35 AM.
    xl2007 - Windows 7
    xl hates the 255 number

  3. #3
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    @ Rahul,

    Couple of points

    1. Since the Function returns nothing, replace 'Function' with 'Sub'

    2. It's case sensitive.
    for non case sensitive adjust the code like
    Code:
    If InStr(1, rngCell, strSearch,vbTextCompare) > 0 Then
    3. Add an error handler. If the search value not found, it gives error.

    An alternative function 'FINDALL' can be found here:

    http://www.excelfox.com/forum/f13/fi...ction-vba-147/
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  4. #4
    Member littleiitin's Avatar
    Join Date
    Aug 2011
    Posts
    90
    Rep Power
    14
    Thanks Admin,

    All Points accepted and incorporated.

    Your Find All function is Awesome.

    Thanks for All your Guidance.

    Regards
    Rahul

  5. #5
    Senior Member
    Join Date
    Apr 2011
    Posts
    190
    Rep Power
    14
    If you want all string comparisons to be case insensetive then use
    Code:
    Option Compare Text
    in the declaration section - so very top line of code.

    Now you can forget about upper/Lower case conflicts
    xl2007 - Windows 7
    xl hates the 255 number

  6. #6
    Member littleiitin's Avatar
    Join Date
    Aug 2011
    Posts
    90
    Rep Power
    14
    Yes Rasm,

    However in some cases you want this differentiation of Upper and Lower case but for one module you need to avoid , then this is useful.

    Thanks

  7. #7
    Member littleiitin's Avatar
    Join Date
    Aug 2011
    Posts
    90
    Rep Power
    14
    Here is simplest Find All Method
    Code:
    Sub FindallM()
        
        Dim rngFind         As Range
        Dim rngWhole        As Range
        Dim rngUnion        As Range
        Dim rngFirstFind    As Range
        Dim rngFirst
        
        Dim strFind     As String
        On Error Resume Next
        strFind = InputBox("Please Enter string to find")
        If Err.Number = 13 Then
            GoTo x1:
        End If
        
        Set rngWhole = ActiveSheet.UsedRange
        Set rngFind = rngWhole.Find(strFind, , , xlPart, , , False)
        If Not rngFind Is Nothing Then
            Set rngUnion = rngFind
            Set rngFirst = rngFind
            Do
                On Error Resume Next
                Set rngFind = rngWhole.FindNext(rngFind)
                Set rngUnion = Union(rngUnion, rngFind)
             Loop Until rngFind.Address = rngFirst.Address
             Err.Clear: On Error GoTo 0: On Error GoTo -1
             rngUnion.Select
        End If
    x1:
    End Sub

Similar Threads

  1. Replies: 1
    Last Post: 06-12-2013, 07:42 PM
  2. Replies: 13
    Last Post: 06-10-2013, 09:05 AM
  3. Replies: 2
    Last Post: 02-06-2013, 12:00 PM
  4. don't copy filtered data if no active cells
    By xander1981 in forum Excel Help
    Replies: 29
    Last Post: 11-01-2012, 06:47 PM
  5. Highlighting Blank Cells
    By Howardc in forum Excel Help
    Replies: 2
    Last Post: 08-13-2012, 07:56 AM

Tags for this Thread

Posting Permissions

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