[VBA] Excel 2010 Error 91

[devcon]

Καλησπέρα

Χρησιμοποιώ την ακόλουθη VBA για την εύρεση ονόματος. Στην περίπτωση που δεν υπάρχει το όνομα μου δίνει σφάλμα 91.
Θα παρακαλούσα κάποια βοήθεια.
Ευχαριστώ εκ των προτέρων.

'Attribute VB_Name = "FindText"
Sub FindText()

Dim i As Long
Dim Fnd As String
Dim fCell As Range
Dim ws As Worksheet
Dim Color As Long
Dim rngCurr As Range

    Fnd = InputBox("Enter text to search" & vbCr & vbCr _
            & "Click OK to search the entire workbook for all instances of the search text." & _
            " Each instance will be highlighted. This search is not case-sensitive, but it will not" & _
            " locate search text if its cell contains other text, including a formula.")

If Fnd = vbNullString Then
           Exit Sub
End If

Application.ScreenUpdating = False
Application.Dialogs(xlDialogPatterns).Show 'shows color palette
Color = ActiveCell.Interior.Color 'stores index number of selected color
ActiveCell.Interior.Color = xlNone
 'since previous line colors cell where cursor pointer is, this removes the shading from that cell
   
Application.ScreenUpdating = True

    Cells.Find(What:=Fnd, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = Color
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
        
first_pos = ActiveCell.Address 'first cell found

Cells.FindNext(After:=ActiveCell).Activate 'find the next cell if any

While ActiveCell.Address <> first_pos 'while nect cell is not the first one

    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = Color
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Cells.FindNext(After:=ActiveCell).Activate
    
Wend

End Sub

[Tasos]

Καλημέρα Θανάση!
Επειδή τα Activate που περιέχονται στον κώδικα δεν είναι ότι γρηγορότερο,
σου προτείνω τον παρακάτω κώδικα που χρωματίζει τα κελιά που περιέχουν το κριτήριο αναζήτησης.

Option Explicit

Sub ColorFoundCells()
    Dim SearchString, FirstAddress As String, _
            lColor As Long, OldColor As Long, rng As Range
    SearchString = Application.InputBox("Enter text to search", Type:=2)
    If SearchString = False Then Exit Sub
    Set rng = Cells.Find(SearchString, LookIn:=xlValues)
    If Not rng Is Nothing Then
        FirstAddress = rng.Address
        OldColor = IIf(ActiveCell.Interior.ColorIndex = xlNone, _
                xlNone, ActiveCell.Interior.Color)
        If Application.Dialogs(xlDialogPatterns).Show Then
            lColor = ActiveCell.Interior.Color
            ActiveCell.Interior.Color = OldColor
        Else
            Exit Sub
        End If
    Else
        MsgBox "Search string not found!", vbInformation
        Exit Sub
    End If
    Do
        rng.Interior.Color = lColor
        Set rng = Cells.FindNext(rng)
    Loop While Not rng Is Nothing And rng.Address <> FirstAddress
End Sub

Καλή συνέχεια!


Το σφάλμα 91 το αποφεύγεις με τη γραμμή: If Not rng Is Nothing Then .... μετά από την αναζήτηση (Find ή FindNext).

Φιλικά

Τάσος

[devcon]

Τάσο καλημέρα,

Όπως πάντα πρόθυμος και εξυπηρετικός με τις άριστες λύσεις όλων των προβλημάτων μας.

Σε ευχαριστώ και σου εύχομαι καλή Κυριακή.

Φιλικά
Θανάσης