Überprüfen, ob Pflichtfelder vor jedem Speichern im Makro nicht leer sind

Question

Ich habe ein Szenario, in dem ich prüfen muss, ob Spalte A nicht leer ist, entsprechende Zeilenwerte in anderen Spalten sollten nicht leer sein. Wenn dies der Fall ist, möchte ich eine Fehlermeldung erhalten.

Also ich kam mit diesem.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ 
    Cancel As Boolean) 

    Dim rngCell As Range 
    Dim lngLstRow As Long, lngTCols As Long 
    Dim lngRowCheck(1 To 5) As String 

    For Each rngCell In Range("A1:A" & lngLstRow) 
     If Not IsEmpty(rngCell.Value) Then 

      lngRowCheck(1) = "C" 
      lngRowCheck(2) = "F" 
      lngRowCheck(3) = "G" 
      lngRowCheck(4) = "J" 

      lngLstRow = ActiveSheet.UsedRange.Rows.Count 

      For i = 1 To UBound(lngRowCheck) 
       For Each rngCell In Range(lngRowCheck(i) & "2:" & lngRowCheck(i) & lngLstRow) 
        If rngCell.Value = 0 Then 
         MsgBox ("Please enter a name in cell " & rngCell.Address) 
         rngCell.Select 
        End If 
       Next 
      Next i 
    Next 
End Sub 

Dies ist jedoch nicht funktioniert und die Validierung nicht geschieht vor jedem Speichern und ich bin nicht in der Lage, dies auch zu debuggen. Irgendeine Hilfe? Mache ich etwas falsch?

Answer 1

Versuchen Sie so etwas wie dieses ...

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ 
Cancel As Boolean) 
Dim rngCell As Range, cell As Range 
Dim lngLstRow As Long, lngTCols As Long 
Dim lngRowCheck(1 To 5) As String 

lngLstRow = ActiveSheet.UsedRange.Rows.Count 

For Each rngCell In Range("A1:A" & lngLstRow) 
    If Not IsEmpty(rngCell.Value) Then 
     lngRowCheck(1) = "C" 
     lngRowCheck(2) = "F" 
     lngRowCheck(3) = "G" 
     lngRowCheck(4) = "J" 

     For i = 1 To UBound(lngRowCheck) 
      For Each cell In Range(lngRowCheck(i) & "2:" & lngRowCheck(i) & lngLstRow) 
       If cell.Value = 0 Then 
        MsgBox "Please enter a name in cell " & cell.Address(0, 0) 
        cell.Select 
        Cancel = True 
        Exit Sub 
       End If 
      Next cell 
     Next i 
    End If 
Next rngCell 

End Sub