Double click cell to fill cell same colour as last row in sheet (with an exception)

[Ironman]

Hi

I'm looking for a bit of code so when I double click cell A8 then that cell is filled the same colour as the last row in the sheet, UNLESS column B of the last row contains the word REST (then do nothing).

Many thanks!

 

[Ironman]

Edit - I need to expand on "last row in the sheet" - I need this to be the last row with text in Col B.

 

[JoeMo]

Untested, but give this s try on a copy of the sheet.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Cells(Rows.Count, "B").End(xlUp).Value = "REST" Then Exit Sub
If Not Intersect(Target, Range("A8")) Is Nothing Then
    Target.Interior.Color = Cells(Rows.Count, "B").End(xlUp).Interior.Color
End If
End Sub

 

[NoSparks]

Why would you need this, isn't it already catered to in your Worksheet_Change event ?

 

[Ironman]

Many thanks Joe, that works perfectly!

 

[Ironman]

Why would you need this, isn't it already catered to in your Worksheet_Change event ?

You're correct, but for some reason Peter's code doesn't always update, so I have to double click Col B of the last row myself for it to do so. However, that seems to create a zero in the next empty cell in the Daily Tracking sheet (per Dante's code), which I wanted to avoid, hence the above request. But as I've just discovered that the activity date doesn't always update either, I'm no further forward really.

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

 

[JoeMo]

Many thanks Joe, that works perfectly!

You are welcome - thanks for the reply.