Wenn nichts Gefunden MsgBox Anzeigen
09.05.2021 18:11:40
oraculix
Habe ein Makro das mir Filme Sucht Funkt auch tadellos.
Aber wenn nichts gefunden wird sollte noch eine MsgBox kommen die Anzeigt
Leider Keine Treffer Gefunden!
Frage:
Wie und was und wo muss den neuen MsgBox in dem untenstehen Code einfügen
'Nach dem suchen wird in Tabelle "Gefunden" der gesuchte Eintrag gelistet.
Public Sub AnsehenFindenUndKopieren2()
Application.ScreenUpdating = False
'Call löschen
Dim iRowT As Long
Dim sWord As String, strFirstAddress As String
Dim objCell As Range
Dim objDictionary As Object
Worksheets("FilmeAnsehen").Activate
sWord = InputBox(Prompt:="Suchbegriff:", Default:="Filmname")
If sWord vbNullString Then
Set objDictionary = CreateObject(Class:="Scripting.Dictionary")
iRowT = 3
With Worksheets("Gefunden")
Set objCell = Union(Columns("A:B"), Columns("H")).Find(What:=sWord, _
LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
If Not objCell Is Nothing Then
strFirstAddress = objCell.Address
Do
If Not objDictionary.Exists(Key:=CStr(objCell.Row)) Then
objDictionary.Item(Key:=CStr(objCell.Row)) = vbNullString
objCell.EntireRow.Copy .Cells(iRowT, 1)
iRowT = iRowT + 1
End If
Set objCell = Union(Columns("A:B"), Columns("H")).FindNext(After:=objCell)
Loop Until objCell.Address = strFirstAddress
Set objCell = Nothing
Set objDictionary = Nothing
.Activate
.UsedRange.Font.Size = 14
With .Range("A2:J5000")
.Font.Color = RGB(255, 192, 0)
.Interior.Color = vbBlack
.Borders.Color = RGB(255, 192, 0)
End With
End If
End With
End If
Worksheets("Gefunden").Activate
Columns("A:A").ColumnWidth = 40.28
Application.ScreenUpdating = True
End Sub
