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

Ironman

Well-known Member
Joined
Jan 31, 2004
Messages
1,069
Office Version
  1. 365
Platform
  1. Windows
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:
VBA 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!
VBA Code:
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!
 
Last edited:
Does this make any difference ?
VBA Code:
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
 
Upvote 0

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
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
 
Upvote 0
P.S. The range of conditions for the validation dropdown box and conditional formatting are shown in Sheet Training Log L2:L7
 
Upvote 0
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 :)
 
Upvote 0
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.
 
Upvote 0
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. :)
 
Upvote 0
This change looks like it works.
VBA Code:
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.
 
Upvote 0
Solution
Hey Jason, that works, thanks ever so much!

And thanks ever so much for your explanation as well, that makes sense.
 
Last edited:
Upvote 0
I can see there's no point in me trying to assist.
Over and Out.
 
Upvote 0
Thanks a lot for trying to help - from my point of view, the solution could just as easily have come from yourself :)
 
Upvote 0

Forum statistics

Threads
1,212,927
Messages
6,110,725
Members
448,294
Latest member
jmjmjmjmjmjm

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