VBA to identify and re-enter value in last cell in column

[Ironman]

Hi

An anomaly in my sheet code means I need to re-input a value in the last cell in a specific column for a cell value in another sheet to register correctly.

This is my code:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Range("MilesToNextYearEndTotal") < 0 Then
  MsgBox "Re-enter latest distance in Daily Tracking sheet", vbExclamation, "Y/E Total negative value anomaly correction"
  Sheets("Daily Tracking").Select
  End If

The below code, courtesy of DanteAmor, then selects the first blank cell in the Daily Tracking sheet in the current year column

Dim f As Range
  Dim i As Long
 
  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).Select
              Exit Sub
            End If
          Else
            Cells(i, f.Column).Select
            Exit Sub
          End If
        End If
      Next
  End If
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

What I'm looking for is for the above to be adapted slightly, so instead of selecting the first blank cell, it selects the cell above it, identifies the value in that cell and 're-enters' it.

Many thanks!

 

[Olibrius]

What is the value to be re-entered? Is it this of the last non-empty cell?
Where should it be re-entered? In the last non-empty cell or in the following one (next line)?

 

[Ironman]

It needs to be equal to the existing value in the cell and entered into the same cell - the last non-empty cell.

As an alternative if it's any easier to write, it's the same value as Col C of the last row of sheet 'Training Log'.

Thanks.

 

[Olibrius]

Then, if you want to use the last non-empty cell, you could replace each occurrence of
Cells(i, f.Column).Select
by
Cells(i, f.Column).Offset(-1, 0).Select
this should select the desired cell.

 

[Ironman]

That's great, thanks Olubrius - could I please ask you for an additional line or two that will re-enter the value?

Thanks again.

 

[Olibrius]

you can use
ActiveCell.Value = ActiveCell.Value

 

[NoSparks]

I believe the simplest solution to what you're asking would be to add this after each of the existing .Select lines in Dante's code

            Cells(i, f.Column).Value = Cells(i - 1, f.Column).Value

 

[Ironman]

Many thanks again Olibrius.

Hi Nolan, many thanks for your input!

I've just realised that Dante's code is in the sheet activation event in 'Daily Tracking', so the above won't run as intended.

What I think would work would be adding your 2 lines to Dante's existing code plus his original code in the 'Daily Tracking' Sheet Activation event as an 'If/Then'. I've tried to do this myself but the below doesn't contain the correct number of 'End If's and 'End With's and I can't get it right).

Private Sub Worksheet_Activate()
  Dim f As Range
  Dim i As Long
  Set f = Range("D1", Cells(1, Columns.Count).End(1)).Find(Year(Date), , xlValues)
 
If Sheets ("Training Log").Range("MilesToNextYearEndTotal") < 0 Then
  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).Select
              Cells(i, f.Column).Value = Cells(i - 1, f.Column).Value

              Exit Sub
            End If
          Else
            Cells(i, f.Column).Select
            Cells(i, f.Column).Value = Cells(i - 1, f.Column).Value
            Exit Sub
          End If
        End If
      Next
  End If

Else
  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).Select
              Exit Sub
            End If
          Else
            Cells(i, f.Column).Select
            Exit Sub
          End If
        End If
      Next
  End If

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Hope you can help?

 

[NoSparks]

You mean like this ?

Private Sub Worksheet_Activate()
  Dim f As Range
  Dim i As Long
  
  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).Select
              Exit For
            End If
          Else
            Cells(i, f.Column).Select
            Exit For
          End If
        End If
      Next
  End If
    
  If Sheets("Training Log").Range("MilesToNextYearEndTotal") < 0 Then
    Cells(i, f.Column).Value = Cells(i - 1, f.Column).Value
  End If
  
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

Mind if I ask a couple of questions?
1) what is the anomaly you are encountering, and
2) Dante's code is the answer to the question you asked here. What guarantees that the first blank cell in the Daily Tracking sheet in the current year column is the appropriate row for the date you're dealing with?

 

[NoSparks]

I guess the last few lines of code should really be in this order in case f is Nothing, although I wouldn't expect that to happen until 2062

            Exit For
          End If
        End If
      Next i
      If Sheets("Training Log").Range("MilesToNextYearEndTotal") < 0 Then
          Cells(i, f.Column).Value = Cells(i - 1, f.Column).Value
      End If
  End If
  
    Application.EnableEvents = True
    Application.ScreenUpdating = True