When text entered in Sheet 1 Col B last row, enter zero in first blank cell of column for current year in Sheet 2

[Ironman]

Hi

I hope you can help me with this please?

When either the word 'REST' or 'OTHER' (both words upper case only) are the first words entered in Column B of the last row of Sheet 'Training Log' I need a 0 (zero) inserting into the first blank cell of Sheet 'Daily Tracking'.

Sheet 'Daily Tracking' Cols D1:CC1 contain years from 1984-2061. Rows 2:367 contain days of the year (including Feb 29).

I need the zero entering in the first cell in the column (searching from the top of the sheet downwards) in the current year (whichever year that is) that does not contain a value, including a zero value i.e. blank and takes account of leap years.

The code to locate the relevant cell in Daily Tracking has already been very kindly provided here - Post #5

All I need is for the above code to be integrated with the 2 conditional words to produce the zero in Sheet 'Daily Tracking'.

Help would be very much appreciated, thank you!

 

[NoSparks]

Hope this works, put it right above the comment line -> 'jump from F to H on the same row

' put a 0 in first empty cell of current year in Daily Tracking sheet
If Target.Column = 2 And Target.Row = lr Then
    If Left(Target.Value, 4) = "REST" Or Left(Target.Value, 5) = "OTHER" Then
        Dim f As Range
        Dim i As Long
        With Sheets("Daily Tracking")
            Set f = .Range("D1", .Cells(1, Columns.Count).End(1)).Find(Year(Date), , xlValues)
            If Not f Is Nothing Then
                For i = 2 To Rows.Count
                  If .Cells(i, f.Column).Value = "" Then
                    If i = 61 Then
                      If Day(DateSerial(Year(Date), 3, 1) - 1) = 29 Then
                        .Cells(i, f.Column) = 0
                        Exit For
                      End If
                    Else
                      .Cells(i, f.Column) = 0
                      Exit For
                    End If
                  End If
                Next i
            End If
        End With
    End If
End If

' jump from F to H on the same row

 

[Ironman]

You beauty! It works brilliantly, thanks ever so much!

 

[Ironman]

Hi again NS

Is there any way that a condition can be added to your code so a zero will not be entered when it's a future date. At present a zero is created every time I double click the last cell in Col B i.e. future dates are showing zeros incorrectly.

I need to be able to do this so that Peter's code (below) will update, as although Peter's code is in a sheet_change event, it doesn't always update unless I close and re-open the workbook or I double click the last cell in Col B, which is less hassle, but creates a zero every time. My original post is here:

  Dim r As Long, Clr As Long
  Dim Txt As String
  
  If Not Intersect(Target, Columns("B")) Is Nothing Then
    With Range("A12", Range("B" & Rows.Count).End(xlUp))
      r = .Rows.Count
      Do Until UCase(.Cells(r, 2).Value) <> "REST" And Not IsEmpty(.Cells(r, 2).Value)
        r = r - 1
      Loop
      Select Case Date - .Cells(r, 1).Value
        Case 0: Txt = "Today"
        Case 1: Txt = "Yesterday"
        Case Else: Txt = Format(.Cells(r, 1).Value, "d mmmm")
      End Select
      Clr = .Cells(r, 1).Interior.Color
    End With
    Application.EnableEvents = False
    With Range("A8")
      .Value = "Last Exercise " & Txt
      .Interior.Color = Clr
    End With

  End If

The alternative (probably much easier I would guess?) would be if you were able to modify your own code below that precedes the above, by say adding a Cancel option to the message box, so if I need to double click the last cell in Col B for the above to work and I then select Cancel then the zero won't be created?

Dim NextRow As Long
Application.EnableEvents = False 'added 09.11.2021
Lr = Range("A" & Rows.Count).End(xlUp).Row

If Target.Column = 2 And Target.Value = "OTHER (IB)" Then
    Range("D" & Target.Row).Validation.Delete 'clears irrelevant Iron Man run validation input info
    Range("E" & Target.Row).ClearContents 'clears irrelevant pace formula
    Range("A" & Target.Row).Resize(, 6).Interior.Color = RGB(197, 217, 241) 'Col A and next 5 columns
    Range("I" & Target.Row).Resize(, 2).Interior.Color = RGB(197, 217, 241) 'Col I and next column
    Range("I" & Target.Row).Value = "INDOOR BIKE SESSION, 60 MINS."
    Range("F" & Target.Row).Select 'move to this cell to start inputting data

    MsgBox "Enter Average Heart Rate", vbInformation, "Indoor Bike Session Data"
Application.EnableEvents = True
End If

Many thanks again!

 

[NoSparks]

Sorry, I don't follow this at all.

 

[Ironman]

Sorry NS, all I'm after is an option to cancel the first set of code below with a message box with a No or Cancel option before it runs
e.g. something like msgbox: "Do you want to enter a zero in Daily Tracking?" vbYesNo
If vbNo then
(don't run the below first set of code

If Target.Column = 2 And Target.Row = Lr Then
    If Left(Target.Value, 4) = "REST" Or Left(Target.Value, 5) = "OTHER" Then
        Dim f As Range
        Dim i As Long
        With Sheets("Daily Tracking")
            Set f = .Range("D1", .Cells(1, Columns.Count).End(1)).Find(Year(Date), , xlValues)
            If Not f Is Nothing Then
                For i = 2 To Rows.Count
                  If .Cells(i, f.Column).Value = "" Then
                    If i = 61 Then
                      If Day(DateSerial(Year(Date), 3, 1) - 1) = 29 Then
                        .Cells(i, f.Column) = 0
                        Exit For
                      End If
                    Else
                      .Cells(i, f.Column) = 0
                      Exit For
                    End If
                  End If
                Next i
            End If
        End With
    End If
End If

Thanks again

 

[NoSparks]

I have a feeling you're digging a hole deeper and deeper as you go.

I need to be able to do this so that Peter's code (below) will update, as although Peter's code is in a sheet_change event, it doesn't always update unless I close and re-open the workbook or I double click the last cell in Col B, which is less hassle, but creates a zero every time.

Why don't you move Peter's code to be the last thing executed in the _Change sub instead of the first ?

 

[Ironman]

What am I like?! Yes, that works fine now - thanks a lot NS, I don't know why I didn't think of that - sorry to bother you.