Hallo Leute!

Ich muss den Code so ergänzen, dass mir eine "OkAbbrechen-Messagebox" angezeigt wird, die folgendes beeinhaltet:

- ein Wert (z.B. "PUR", "SPEZIAL", "PE", "DA", "TPE", "PVC"), soll 12 Spalten weiter entnommen werden und das bei allen auf WS1 festgestellten Positionen

- die Messagebox soll alle Anzahlen anzeigen also z.B. Anzahl "PUR": 6, Anzahl "SPEZIAL": 3, Anzahl "PE": 4 usw.

- dazu dann die Abfrage: "Ist das so in Ordnung?" bei "Ok" nichts tun und bei "Abbrechen" dann den "c.Interior.ColorIndex = xlNone"-Befehl

Ich habe schonmal angefangen (siehe Tabelle2 (Kalkulation) in VBA), komme allerdings leider nicht weiter.

Vielen Dank im Voraus!
Gruß Sandro

Option Explicit

Private Sub CheckBox3_Click()
        Dim zelle As Range
        Dim letzte As Long
        Dim strAusgabe As String
        With Worksheets("Kalkulation")
         For Each zelle In Worksheets("Kalkulation").Range("A1:C1000")
          If CheckBox3 = True And zelle.Interior.ColorIndex = 3 Then
          zelle.Interior.ColorIndex = 2 And zelle.Borders(xlEdgeTop).LineStyle = xlContinuous
          End If
         Next
        End With
End Sub

Private Sub CheckBox4_Click()
If CheckBox4 = True Then
        Dim zelle As Range
        Dim letzte As Long
        Dim strAusgabe As String
        With Worksheets("Kalkulation")
         For Each zelle In Worksheets("Kalkulation").Range("A1:C1000")
          If zelle.Interior.ColorIndex = 3 Then
           strAusgabe = strAusgabe & vbLf & zelle.Address
          End If
         Next
         MsgBox strAusgabe
        End With
    End If
End Sub

Private Sub CommandButton2_Click()
Dim WS1 As Worksheet: Set WS1 = Worksheets("Kalkulation")
Dim WS2 As Worksheet: Set WS2 = Worksheets("CFBlanco2018")
Dim c As Range

For Each c In WS1.Columns(2).SpecialCells(xlCellTypeConstants)
    If UCase(Left(c, 2)) = "AB" Then
        If WS1.Range("E3") <= WorksheetFunction.VLookup(c, WS2.Range("B:J"), 9, 0) Then
            c.Interior.ColorIndex = 3
            If WS1.OLEObjects("CheckBox3").Object.Value Then MsgBox "Fehler: " & c
        Else
            c.Interior.ColorIndex = xlNone
        End If
    End If
Next c
End Sub

Private Sub CommandButton3_Click()
Dim WS1 As Worksheet: Set WS1 = Worksheets("Kalkulation")
Dim WS2 As Worksheet: Set WS2 = Worksheets("CFBlanco2018")
Dim c As Range

For Each c In WS1.Columns(2).SpecialCells(xlCellTypeConstants)
    If UCase(Left(c, 2)) = "AB" Then
            If MsgBox("Ist die Anzahl der Qualitäten in Ordnung?" & vbCr & vbCr & vbCr & "Objekt für Anzahl der Qualitäten!", vbOKCancel, "Anzahl Qualitäten") = vbOK Then
        MsgBox "Prima!"
            Else
        MsgBox "Der Vorgang wurde abgebrochen."
            End If
    
        'WorksheetFunction.VLookup(c, WS2.Range("B:N"), 13, 0).Value
    End If
Next c
End Sub