Zelle färben wenn der Wert gefunden wird VBA

[Alberto]

Hallo zusammen,

ich habe einen Code, der nach Werten in einer Datenblatt sucht. So weit funktioniert der Code gut aber ich möchte, wenn der Wert gefunden wird dass die Celle grün gefärbt und so weiter..
Hier ist der Code:

Sub CommandButton2_Click()
Dim Suchbegriff$
On Error GoTo Fehler
Suchbegriff = InputBox("bitte Suchbegriff eingeben", , "Test")
If StrPtr(Suchbegriff) = 0 Then Exit Sub
Cells.Find(What:=Suchbegriff, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole).Activate
weiter:
Cells.FindNext(After:=ActiveCell).Activate
If MsgBox("Fund in " & ActiveCell.Address & vbLf & "weiter suchen?", vbYesNo, "  Suche -> " & _
Suchbegriff) = vbYes Then GoTo weiter

Exit Sub
Fehler:
MsgBox "Suchbegriff wurde nicht gefunden"

End Sub



wie kann man den Code anpassen ??
Danke im Voraus.

Gruß
Alberto

[Gast 123]

Hallo

versuche es bitte mal damit. Ich verwende kein Select, sondern eine Set Anweisung. Dadurch kann man den Fehler bei "No Find" abfangen!
In der Suchzeile kann man statt ActiveCell für den Suchstart auch eine definierte Adresse angeben. Und kann Zeilen oder Spalten durchsuchen!
Die grüne Farbe musst du ggf. selbst anpassen.

mfg Gast 123

Code:

Sub CommandButton2_Click()
Dim Suchbegriff, AcAdr, DlgTxt
Dim rFind As Range, Adr1 As String
Suchbegriff = InputBox("bitte Suchbegriff eingeben", , "Test")
If Suchbegriff = Empty Then Exit Sub      'oder Range("A1")  xlRows oder xlColumns!
Set rFind = Cells.Find(What:=Suchbegriff, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not rFind Is Nothing Then
   Cells.Interior.Color = xlNone
   Adr1 = rFind.Address   '1. Find Adressde
   DlgTxt = "  Suche -> " & Suchbegriff
   Do
      rFind.Select
      rFind.Interior.Color = 65280
      AcAdr = ActiveCell.Address(0, 0)
      If MsgBox("Fund in " & AcAdr & vbLf & "weiter suchen?", vbYesNo, DlgTxt) = vbNo Then Exit Do
      Set rFind = Cells.FindNext(rFind)
   Loop Until rFind.Address = Adr1
Else  'Nicht gefunden!
   MsgBox "Suchbegriff wurde nicht gefunden"
End If
Range("A1").Select
End Sub