VBA/Macro Assistance-Forecasting removal

[ld1414]

Good Afternoon,

Looking for assistance on VBA coding. A very helpful member on this board assisted me some time ago with a macro that helped removed old salary forecast. The code was setup to remove any forecasts in columns F-I by comparing today's date to the dates entered in Column E. If today's date was greater than the date in column E, then the forecasting in that row was removed. The original code is below and works fantastic. (see screenshot below)


My question is the following:
I was hoping if we could make an adjustment to this code. Some members of my team need to do journal adjustments on prior dates and they forecast on this sheet. I was wondering if it's possible to not have the current macro code remove old forecasting if they mark a certain condition. My thought process is we use Column C, call it "transfer pending". Then our team can mark "X" or "yes/no". If one of those conditions is met, then the coding does not remove that forecast for that particular row.

Is this possible or any recommendations on how else to adjust? Thank you



Current Macro Code
Sheets("Personnel Forecast").Select
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "F").End(xlUp).Row
For i = 2 To Lastrow
If Cells(i, "E").Value < Date Then Cells(i, "F").Resize(, 4).ClearContents
Next
Application.ScreenUpdating = True
ActiveWorkbook.Save

 

[GWteB]

How about ...

Sub Id1414()
    Const TRANSFERPENDING As String = "X"       ' <<< Change to suit

    Sheets("Personnel Forecast").Select
    With ActiveSheet
        Application.ScreenUpdating = False
        Dim i As Long
        Dim Lastrow As Long
        Lastrow = .Cells(.Rows.Count, "F").End(xlUp).Row
        For i = 2 To Lastrow
            If .Cells(i, "E").Value < Date Then
                If StrComp(.Cells(i, "C").Value, TRANSFERPENDING, vbTextCompare) = 0 Then
                    'do nothing, don't clear cells
                Else
                    .Cells(i, "F").Resize(, 4).ClearContents
                End If
            End If
        Next
        Application.ScreenUpdating = True
        .Parent.Save
    End With
End Sub

 

[ld1414]

That worked! Huge thank you GW

 

[GWteB]

Glad to help and thanks for letting me know