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

Well-known Member
Joined
Jan 31, 2004
Messages
1,069
Office Version
  1. 365
Platform
  1. Windows
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!
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Hope this works, put it right above the comment line -> 'jump from F to H on the same row
VBA Code:
' 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
 
Upvote 0
Solution
You beauty! It works brilliantly, thanks ever so much!
 
Upvote 0
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:
VBA Code:
  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?
VBA Code:
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!
 
Upvote 0
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
VBA 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 :)
 
Last edited:
Upvote 0
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 ?
 
Upvote 0
:rolleyes: :rolleyes: :rolleyes: 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.
 
Upvote 0

Forum statistics

Threads
1,223,243
Messages
6,170,967
Members
452,371
Latest member
Frana

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top