Can't understand why incorrect color fill being applied in VBA code

[Ironman]

Hi

I was kindly given the below code many years ago. When the contents of a cell in Col H of sheet 'Training Log' are manually copied to a cell in Col E of sheet 'Analysis' and then the cell in Analysis is clicked, a hyperlink is created and the cell is filled the same shade as the cell in Col H of Training Log.

However, after I applied conditional formatting to Column H of Training Log, the colour copied is no longer correct and curiously is always the same colour (I also can't work out why it's that colour because none of the cells in either sheet are that colour).

Here's the code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 5 Or Target.Cells.Count > 1 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
Application.ScreenUpdating = False
Dim FindWhat$, FindWhere As Variant
FindWhat = Left(Target.Value, 255)

Set FindWhere = _
Sheets("Training Log").Columns(9).Find(What:=FindWhat, LookIn:=xlFormulas, lookat:=xlPart, MatchCase:=True)
If FindWhere Is Nothing Then Exit Sub

Dim iIndex%
iIndex = Sheets("Training Log").Cells(FindWhere.Row, 8).Interior.ColorIndex  '''''''''''this is the critical line
Target.Hyperlinks.Add _
Anchor:=Target, _
Address:="", _
SubAddress:="'Training Log'!I" & FindWhere.Row, _
TextToDisplay:="LOG ENTRY", _
ScreenTip:="Go to Training Log I" & FindWhere.Row
Target.Interior.ColorIndex = iIndex
With Target
.Font.Name = "Comic Sans MS"
.Font.Size = 7
.Font.Bold = True
.Font.Underline = xlUnderlineStyleSingle
Application.ScreenUpdating = True
End With

End Sub

I have another macro that does the same thing automatically i.e. copies the colour from the same column in Training Log, but to a different sheet as below, and it does it perfectly. I don't understand why the above doesn't work when I activate it by clicking the cell, but the below does when it's fully automated!

If Target.Column = 8 And Target.Row = Range("A" & Rows.Count).End(xlUp).Row Then
Range("H" & Target.Row).Validation.Delete 'added 31.10.2021 - clears validation input info, no longer needed
    Lr1 = Target.Row
    If UCase(Trim(Left(Sheets("Training Log").Range("I" & Lr1).Value, 19))) = "INDOOR BIKE SESSION" Then
        Lr2 = Sheets("Indoor Bike").Range("A" & Rows.Count).End(xlUp).Row + 1
        Sheets("Indoor Bike").Range("F" & Lr2 & ":G" & Lr2).Value = Sheets("Training Log").Range("F" & Lr1 & ":G" & Lr1).Value  'ave heart rate
        Sheets("Indoor Bike").Range("I" & Lr2).Value = Sheets("Training Log").Range("H" & Lr1).Value  'session rating  '''''''''this is the critical line

I'd be very grateful for an amendment to the first macro so the cell in Col E of Analysis sheet is filled with the correct colour.

Thank you!

 

[NoSparks]

Does this make any difference ?

Dim iIndex
iIndex = Sheets("Training Log").Cells(FindWhere.Row, 8).DisplayFormat.Interior.Color
Target.Hyperlinks.Add _
Anchor:=Target, _
Address:="", _
SubAddress:="'Training Log'!I" & FindWhere.Row, _
TextToDisplay:="LOG ENTRY", _
ScreenTip:="Go to Training Log I" & FindWhere.Row
Target.Interior.Color = iIndex

 

[Ironman]

Dim iIndex
iIndex = Sheets("Training Log").Cells(FindWhere.Row, 8).DisplayFormat.Interior.Color
Target.Hyperlinks.Add _
Anchor:=Target, _
Address:="", _
SubAddress:="'Training Log'!I" & FindWhere.Row, _
TextToDisplay:="LOG ENTRY", _
ScreenTip:="Go to Training Log I" & FindWhere.Row
Target.Interior.Color = iIndex

Hi Nolan, many thanks for your input, good to hear from you again - I was just in the process of uploading my workbook.

I've just tried that and it made no difference - still the same shading for all conditions as before.

Here's the workbook link FYI, hope that helps...

Please look at the bottom row of sheet Training Log Col i for clarity.

Thanks again.

Here

 

[Ironman]

P.S. The range of conditions for the validation dropdown box and conditional formatting are shown in Sheet Training Log L2:L7

 

[Ironman]

Incidentally Nolan, it's your code that copies the cell fill colour perfectly to the Indoor Bike sheet, which hopefully you will remember and recognise - thanks again for that

 

[NoSparks]

I can't run your workbook.
But I can see that the Worksheet_SelectionChange code you originally posted is still what you have.

When I copy the Training Log sheet and the Analysis sheet to a new workbook and
alter the Analysis Worksheet_SelectionChange to what is suggested in post 11,
the color changes to yellow for me when copying I8716 and pasting it into E369
then clicking out and back in.

 

[Gokhan Aycan]

Hey, try copying DisplayFormat.Interior.Color:

Range(destination).Interior.Color = Range(source).DisplayFormat.Interior.Color

StackOverflow

Edit: Just saw it is in one of code's above.

 

[jasonb75]

This change looks like it works.

Dim iIndex As Long
iIndex = Sheets("Training Log").Cells(FindWhere.Row, 8).DisplayFormat.Interior.Color
Target.Hyperlinks.Add _
Anchor:=Target, _
Address:="", _
SubAddress:="'Training Log'!I" & FindWhere.Row, _
TextToDisplay:="LOG ENTRY", _
ScreenTip:="Go to Training Log I" & FindWhere.Row 'DON'T EVER RENAME THE ABOVE LINE "COMMENTS" or the hyperlink will locate the one cell in Training Log that contains the word "Comments" H1869 - see above comments 07.03.2019
Target.Interior.Color = iIndex

ColorIndex doesn't include all colours so that is likely part of the reason for it returning an unknown colour. iIndex was declared as Integer so couldn't cope with the full colour range. By changing the declaration to Long, then changing ColorIndex to Color and looking at the display format rather than the actual format, it appears to be working as required.

 

[Ironman]

Hey Jason, that works, thanks ever so much!

And thanks ever so much for your explanation as well, that makes sense.

 

[NoSparks]

I can see there's no point in me trying to assist.
Over and Out.

 

[Ironman]

Thanks a lot for trying to help - from my point of view, the solution could just as easily have come from yourself