könnte mir jemand beim Erweitern helfen?
Damit dem gezeigten VBA kommt eine
MsgBox "Kleine Hilfe von Marcy: Artikel " & Target & " schon vorhanden in Zelle" & vbLf & strTabellen
wenn in dem Bereich E18:M1057 der Eintrag schon vorhanden ist.
Der doppelte Eintrag ist möglich, man wird lediglich aufmerksam gemacht.
Das soll verhindern, dass eine Identnummer bei der Regalerstellung mehrfach eingelagert wird.
Was mich jetzt nervt, dass ich in dem genannten Bereich mehrfach X, E, G, F oder V eintragen muss.
Dann kommt jedes mal die MsgBox.
Gesuchte Erweiterung:prüfe ob der Eintrag im Bereich E18:M1057 schon vorhanden ist,
ausser, wenn der Eintrag ein X E G F oder V ist.
Den Satz: If Target "" Then
habe ich durch
If Target "G" Then ersetzt, bin somit der Lösung ein Schritt näher, aber nur bei Eintrag G.
Wie führe ich den Satz weiter, dass auch keine Meldung kommt bei X, E, F, oder V?
Gruß Marcy
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim raZelle As Range
Dim strTabellen As String
Dim wsTabelle As Worksheet
Dim strStartadresse As String
Select Case Sh.Name
Case "LAYOUT", "Regal 13"
If Not Intersect(Target, Range("E18:M1057")) Is Nothing Then
If Target.Count = 1 Then
If Target "" Then For Each wsTabelle In _
Worksheets
If wsTabelle.Name "Stammdaten" And wsTabelle.Name " _
Lagerortsliste" And wsTabelle.Name "Übersicht" Then
Set raZelle = wsTabelle.Range("E18:M1057").Find(Target, lookat:= _
xlWhole)
If Not raZelle Is Nothing Then
strStartadresse = raZelle.Address
Do
If wsTabelle.Name Sh.Name Then
strTabellen = strTabellen & vbLf & wsTabelle.Name & _
" " & raZelle.Address
Else
If raZelle.Address Target.Address Then _
strTabellen = strTabellen & vbLf & wsTabelle.Name & " " & raZelle.Address
End If
Set raZelle = wsTabelle.Range("E18:M1057").FindNext( _
raZelle)
Loop While Not raZelle Is Nothing And raZelle.Address _
strStartadresse
End If
End If
Next wsTabelle
End If
End If
End If
End Select
If strTabellen "" Then MsgBox "Kleine Hilfe von Marcy: Artikel " & Target & " schon _
vorhanden in Zelle" & vbLf & strTabellen
Set raZelle = Nothing
End Sub