Code needed instead of existing formula to match fill colour of cell

[Ironman]

Hi

The below formula relates to Post #9 of this thread

SWITCH(TODAY()-MAXIFS(A12:A36000,B12:B36000,"<>REST",B12:B36000,"<>"),0,"Last Exercise Today",1,"Last Exercise Yesterday","Last Exercise " &TEXT(MAXIFS(A12:A36000,B12:B36000,"<>REST",B12:B36000,"<>"),"dd/mm/yyy"))

The below are Columns A & B from the most recent entries from sheet 'Training Log' that runs from A12:A36000

Sun, 1 Aug 2021	Cullingworth Rd/Viaduct/ Stn Road/Old Allen Road Back Lane/Wilsden Rd/ Cottingley Rd/Lee Lane/ Cross Lane/Coplowe Ln/ Crack Lane/Main Street/ Harden Ln/Mill Hill Top/ Wilsden Rd/Mad Mile/ Greenside Lane (21/02/2020)
Mon, 2 Aug 2021	OTHER
Tue, 3 Aug 2021	REST
Wed, 4 Aug 2021	OTHER
Thu, 5 Aug 2021	Hallas Br/Down Bents Ln Harden Lane/Smithy Ln/ Lee Farm/Black Hills/ Golf Course/R down Beck Foot Lane/Wagon Lane/ Up LLC to cannon monument/Back to 3-Rise Locks & over Br/ Brown Cow/Main Road all the way back home (22/04/2007)
Fri, 6 Aug 2021	OTHER
Sat, 7 Aug 2021	REST
Sun, 8 Aug 2021	OTHER

The formula above returns the most recent exercise activity date and works perfectly. However, I've been extremely reliably informed that what I now need in addition can only be done using VBA, and it would probably be a neater solution if it replaced the above formula as well.

I need the result cell (A8) fill colour to match the colour of the relevant cell. For the above table, this means I need the result cell to be filled the same colour (blue) as the most recent cell in column B that is not "REST".

I guess that's clear, but here's another table for another example

Mon, 2 Aug 2021	OTHER
Tue, 3 Aug 2021	REST
Wed, 4 Aug 2021	OTHER
Thu, 5 Aug 2021	Hallas Br/Down Bents Ln Harden Lane/Smithy Ln/ Lee Farm/Black Hills/ Golf Course/R down Beck Foot Lane/Wagon Lane/ Up LLC to cannon monument/Back to 3-Rise Locks & over Br/ Brown Cow/Main Road all the way back home (22/04/2007)

If this was the most recent exercise, I would expect the fill colour of the result cell A8 in this instance to be the same shade of green.

A solution would be greatly appreciated.

Many thanks!

 

[Ironman]

Just to clarify, this:

Last Exercise 10 August

I know I can just change the format of the source cell but I want to keep that the same.

 

[Peter_SSs]

Can this be modified so it's the equivalent of "Last Exercise " & the date in the format dd mmmm please?

Try this. You can change the date format in that blue line to whatever you want.

Private Sub Worksheet_Change(ByVal Target As Range)
  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, "dd 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
    Application.EnableEvents = True
  End If
End Sub

 

[Ironman]

Perfect - and lightning fast too!

Thank you so much Peter!

Best regards

Paul

 

[Peter_SSs]

Cheers.

 

[Ironman]

Hmm, I've just opened the worksheet (today is Mon 16 Aug) and this is what the latest entries look like:

Fri, 13 Aug 2021	Hallas Br/Down Bents Ln Harden Lane/Smithy Ln/ Lee Farm/Black Hills/ Golf Course/R Beck Foot Lane/Wagon Lane/ Up LLC across first jctn to post/Back to 3-Rise Locks & over Bridge/ Brown Cow/Main Road all the way back home
Sat, 14 Aug 2021	OTHER
Sun, 15 Aug 2021	REST

Cell A8 looks like this:

Last Exercise Yesterday

But Saturday was 2 days ago, so it should say "Last Exercise 14 August"

When I input a new entry it works fine and then A8 displays correctly but realistically the data in A8 should look correct before I do that.

Because it's a change event

Private Sub Worksheet_Change(ByVal Target As Range)

then I have to enter something in column B of the first new row for A8 to display correctly, but is it possible for A8 to 'reflect' today's date so it looks correct before I actually make a new entry?

Thanks again!

 

[Peter_SSs]

How many worksheets in the workbook?
If more than one, what is the name of this one?

BTW, when using XL2BB, why do you use 'Table only' and then have to tell us what the ranges are? Why not use Mini Sheet then we can easily see the ranges - and the worksheet name?

 

[Ironman]

How many worksheets in the workbook?
If more than one, what is the name of this one?

BTW, when using XL2BB, why do you use 'Table only' and then have to tell us what the ranges are? Why not use Mini Sheet then we can easily see the ranges - and the worksheet name?

Hi Peter, there are 20.

This sheet is Sheet 1 (Training Log).

Yes, good question. I had tried Mini Sheet before using Table, but the workbook hung because it was trying to process other rows and the other sheets that relate to it, even though I'd highlighted just the relevant cells, so I didn't dare do that again. When I then used the 'table' option, that worked fine and seemed to be acceptable - but it clearly isn't - sincere apologies, I hadn't realised, but I don't know how to avoid the workbook going crazy again? I've just tried it again, and I get the same thing involving other sheets, although it didn't hang for as long this time.

 

[Peter_SSs]

Put this in the ThisWorkbook module

Private Sub Workbook_Open()
  With Sheets("Training Log").Range("B12")
    .Value = .Value
  End With
End Sub

In relation to XL2BB you should just be selecting a small area and there shouldn't be a problem.
If you have larger data and want to show, say A8 and rows 10,000 to 10,010 then do two mini-sheets. You can do both at once. For example, for these mini-sheets below, I selected A8 then used the Ctrl key to also select A10,000 to B10,010 then clicked Mini-Sheet and pasted here.

Ironman.xlsm
	A
8	Last Exercise 14 August
Training Log

Ironman.xlsm
	A	B
10000	Sunday, 1 August 2021	Cullingworth Rd/Viaduct/ Stn Road/Old Allen Road Back Lane/Wilsden Rd/ Cottingley Rd/Lee Lane/ Cross Lane/Coplowe Ln/ Crack Lane/Main Street/ Harden Ln/Mill Hill Top/ Wilsden Rd/Mad Mile/ Greenside Lane (21/02/2020)
10001	Monday, 2 August 2021	OTHER
10002	Tuesday, 3 August 2021	REST
10003	Wednesday, 4 August 2021	OTHER
10004	Thursday, 5 August 2021	Hallas Br/Down Bents Ln Harden Lane/Smithy Ln/ Lee Farm/Black Hills/ Golf Course/R down Beck Foot Lane/Wagon Lane/ Up LLC to cannon monument/Back to 3-Rise Locks & over Br/ Brown Cow/Main Road all the way back home (22/04/2007)
10005	Friday, 6 August 2021	REST
10006	Sunday, 8 August 2021	OTHER
10007	Saturday, 14 August 2021	xxx
10008
10009
10010
Training Log

 

[Ironman]

Many thanks Peter, that looks fine now!

Indeed, I had only selected 6 cells to test it and I still had the problem with the macro involving other sheets, which was why I shied away from it.

Anyway, although the same thing happened just now, here's what I've just done

Exercise Log.xlsm
	A	B
8637	Fri, 13 Aug 2021	Hallas Br/Down Bents Ln Harden Lane/Smithy Ln/ Lee Farm/Black Hills/ Golf Course/R Beck Foot Lane/Wagon Lane/ Up LLC across first jctn to post/Back to 3-Rise Locks & over Bridge/ Brown Cow/Main Road all the way back home
8638	Sat, 14 Aug 2021	OTHER
8639	Sun, 15 Aug 2021	REST
Training Log

Thanks once again Peter!

 

[Peter_SSs]

Many thanks Peter, that looks fine now!

Good news.