Clever-Excel-Forum - Zelle färben wenn der Wert gefunden wird VBA

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

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