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

Ironman

Well-known Member
Joined
Jan 31, 2004
Messages
949
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:

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
14,621
Office Version
  1. 365
Platform
  1. Windows
Thanks a lot for trying to help - from my point of view, the solution could just as easily have come from yourself
It did! I just looked back and the 'solution' that I posted was exactly the same as the one from @NoSparks in post 11 which you said 'made no difference'
The only exception being that Nolan declared iIndex as a variant rather than long, but that would still work correctly.
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).

Ironman

Well-known Member
Joined
Jan 31, 2004
Messages
949
Office Version
  1. 365
Platform
  1. Windows
I'm sorry, I didn't get the drift of what Nolan said. I did try that but it didn't work for me. I didn't mean to upset anybody, I just posted what I found with what I'd tried.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,125
Messages
5,768,259
Members
425,460
Latest member
Astros1243

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
Top