Option Explicit
Private Function DeleteAF(ByVal lngRow As Long) As Boolean
Dim wsh As Worksheet
Dim rng As Range
Dim iCol As Integer
Dim bEmpty As Boolean
Set wsh = ActiveWorkbook.Worksheets(1)
bEmpty = True
DeleteAF = CBool(Not wsh.Cells(lngRow, 3).Value = Date)
If DeleteAF Then
For iCol = 32 To 3 Step -1
With wsh.Cells(lngRow, iCol)
If Not .Locked Or Not wsh.ProtectContents Then
If iCol = 3 Then
If Not bEmpty Then
If lngRow = 2 Then
.Value = Date
Else
.ClearContents
If Not wsh.ProtectContents Then
.NumberFormat = "General"
End If
End If
End If
Else
If IsEmpty(.Offset(ColumnOffset:=-1).Value) Then
.ClearContents
If Not wsh.ProtectContents Then
.NumberFormat = "General"
End If
Else
.Value = .Offset(ColumnOffset:=-1).Value
bEmpty = False
End If
End If
End If
End With
Next
End If
End Function
Sub FixAll()
Dim iRow As Integer
Dim myCalc As XlCalculation
myCalc = Application.Calculation
Application.Calculation = xlManual
For iRow = 2 To 30
If Not DeleteAF(iRow) Then
MsgBox "Der Befehl wurde heute bereits ausgeführt!", vbCritical
Exit For
End If
Next
Application.Calculate
Application.Calculation = myCalc
End Sub