Why isn't my fill cell colour code working?

Ironman

Ironman

Well-known Member
Joined
Jan 31, 2004
Messages
1,069
Office Version
  1. 365
Platform
  1. Windows
Hi

Can you tell me why the first part works fine but the second part doesn't?
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 And Target.Row = Range("A" & Rows.Count).End(xlUp).Row Then
    Lr1 = Target.Row
 
'this part works fine
 If Sheets("Training Log").Range("D" & Lr1).Value >= 0.0833 And Sheets("Training Log").Range("D" & Lr1).Value < 0.1249 Then
       Sheets("Training Log").Range("D" & Lr1).Resize(, 1).Interior.Color = RGB(255, 204, 153)
    End If
 
   If Sheets("Training Log").Range("D" & Lr1).Value >= 0.125 And Sheets("Training Log").Range("D" & Lr1).Value < 0.1458 Then
       Sheets("Training Log").Range("D" & Lr1).Resize(, 1).Interior.Color = RGB(191, 191, 191)
    End If
 
   If Sheets("Training Log").Range("D" & Lr1).Value >= 0.1459 And Sheets("Training Log").Range("D" & Lr1).Value < 0.1665 Then
       Sheets("Training Log").Range("D" & Lr1).Resize(, 1).Interior.Color = RGB(255, 204, 0)
    End If
 
   If Sheets("Training Log").Range("D" & Lr1).Value >= 0.1667 Then
       Sheets("Training Log").Range("D" & Lr1).Resize(, 1).Interior.Color = RGB(242, 242, 242)
    End If
 
'this part doesn't (no error but no fill either)
 If Sheets("Training Log").Range("C" & Lr1).Value >= 9.9 And Sheets("Training Log").Range("C" & Lr1).Value < 13.2 Then
       Sheets("Training Log").Range("C" & Lr1).Interior.Color = RGB(255, 204, 153)
    End If
 
  If Sheets("Training Log").Range("C" & Lr1).Value >= 13.2 And Sheets("Training Log").Range("C" & Lr1).Value < 15.1 Then
       Sheets("Training Log").Range("C" & Lr1).Interior.Color = RGB(191, 191, 191)
    End If
 
  If Sheets("Training Log").Range("C" & Lr1).Value >= 15.1 And Sheets("Training Log").Range("C" & Lr1).Value < 17 Then
       Sheets("Training Log").Range("C" & Lr1).Interior.Color = RGB(255, 204, 0)
    End If
 
   If Sheets("Training Log").Range("C" & Lr1).Value >= 17 Then
        Sheets("Training Log").Range("C" & Lr1).Interior.Color = RGB(242, 242, 242)
    End If
 
    End If
End If
I'm guessing it's because the target column is D not C but I don't know how to code it to get both parts to work.

I'd be grateful for some code that will do this.

Many thanks!
 
Last edited:

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Sort by date Sort by votes
Are you wanting that part to run when column C is updated?
Because your initial IF...THEN, which everything else is enclosed in, is only looking for changes in column D, not column C, i.e.
Rich (BB code): 
If Target.Column = 4 And Target.Row = Range("A" & Rows.Count).End(xlUp).Row Then

You probably want to end that IF...THEN before your second part, and then add another all-encomparring IF...THEN, checking for column C updates, i.e.
Rich (BB code): 
If Target.Column = 3 And ...
 
Upvote 0
Thanks Joe.

I just tried your suggestion as below (if I've understood you correctly) and it still doesn't work.
VBA Code: 
If Target.Column = 4 And Target.Row = Range("A" & Rows.Count).End(xlUp).Row Then
    Lr1 = Target.Row

    If Sheets("Training Log").Range("D" & Lr1).Value >= 0.0833 And Sheets("Training Log").Range("D" & Lr1).Value < 0.1249 Then
       Sheets("Training Log").Range("D" & Lr1).Resize(, 1).Interior.Color = RGB(255, 204, 153)
    End If

    If Sheets("Training Log").Range("D" & Lr1).Value >= 0.125 And Sheets("Training Log").Range("D" & Lr1).Value < 0.1458 Then
       Sheets("Training Log").Range("D" & Lr1).Resize(, 1).Interior.Color = RGB(191, 191, 191)
    End If
   
    If Sheets("Training Log").Range("D" & Lr1).Value >= 0.1459 And Sheets("Training Log").Range("D" & Lr1).Value < 0.1665 Then
       Sheets("Training Log").Range("D" & Lr1).Resize(, 1).Interior.Color = RGB(255, 204, 0)
    End If
   
    If Sheets("Training Log").Range("D" & Lr1).Value >= 0.1667 Then
       Sheets("Training Log").Range("D" & Lr1).Resize(, 1).Interior.Color = RGB(242, 242, 242)
    End If
    End If
   

    If Target.Column = 3 And Target.Row = Range("A" & Rows.Count).End(xlUp).Row Then
    Lr3 = Target.Row
    If Sheets("Training Log").Range("C" & Lr3).Value >= 9.9 And Sheets("Training Log").Range("C" & Lr3).Value < 13.2 Then
       Sheets("Training Log").Range("C" & Lr3).Interior.Color = RGB(255, 204, 153)
    End If
   
    If Sheets("Training Log").Range("C" & Lr3).Value >= 13.2 And Sheets("Training Log").Range("C" & Lr3).Value < 15.1 Then
       Sheets("Training Log").Range("C" & Lr3).Interior.Color = RGB(191, 191, 191)
    End If
   
    If Sheets("Training Log").Range("C" & Lr3).Value >= 15.1 And Sheets("Training Log").Range("C" & Lr3).Value < 17 Then
       Sheets("Training Log").Range("C" & Lr3).Interior.Color = RGB(255, 204, 0)
    End If
   
    If Sheets("Training Log").Range("C" & Lr3).Value >= 17 Then
       Sheets("Training Log").Range("C" & Lr3).Interior.Color = RGB(242, 242, 242)
    End If
    End If
End If
 
Upvote 0
As an aside, does using code to conditionally format use less resources than conditional formatting? If it makes no difference then I might as well do this using CF.
 
Upvote 0
You have an extra "End If" at the end.

As an aside, does using code to conditionally format use less resources than conditional formatting? If it makes no difference then I might as well do this using CF.
Click to expand...
General rule of thumb:
If you can accomplish what you need using Conditional Formatting, then use it. No need to use VBA to recreate something that already exists.
 
Upvote 0
Thanks again Joe - I removed an End If from the last part of the code as below
VBA Code: 
    If Sheets("Training Log").Range("C" & Lr3).Value >= 17 Then
       Sheets("Training Log").Range("C" & Lr3).Interior.Color = RGB(242, 242, 242)
    End If
End If
And then it returned Error, Block If without End If. There is actually some other code using Lr2 (which also works OK) with an End If so maybe that's why you thought there were too many.
 
Upvote 0
OK, let's step back and get a complete 360 view of the issue:

1. Post your ENTIRE updated code, so we can correctly diagnose where issues may exist.

2. Please explain what you are doing when the problem occurs, i.e.
- What does your data look like?
- What exactly are you doing to fire off the code (what cell are you updating with what)?
- What is your desired result?
- What is actually happening, if anything?
 
Upvote 0
'Sheet 'Training Log'
Sun, 28 Nov 2021Hallas Br/Down Bents Ln Harden Lane/Smithy Ln/ Lee Farm/Blackhills/Golf Course/R down Beck Foot Lane/Wagon Lane/Down LLC to Hirst Wood Lock (to post)/Back up to 5-Rise Locks/Down to 3-Rise & over Br/Brown Cow/Main Rd all the way back home12.23:07:51


'Sheet 'Iron Man Log'
Sun, 28 Nov 202112.23:07:51


VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 And Target.Row = Range("A" & Rows.Count).End(xlUp).Row Then
    Lr1 = Target.Row
    If Sheets("Training Log").Range("D" & Lr1).Value >= 0.0833 Then
        Lr2 = Sheets("Iron Man Log").Range("A" & Rows.Count).End(xlUp).Row + 1
        Sheets("Iron Man Log").Range("A" & Lr2).Value = Sheets("Training Log").Range("A" & Lr1).Value  'date
        Sheets("Iron Man Log").Range("B" & Lr2).Value = Sheets("Training Log").Range("C" & Lr1).Value  'distance
        Sheets("Iron Man Log").Range("C" & Lr2).Value = Sheets("Training Log").Range("D" & Lr1).Value  'time
 
    If Sheets("Training Log").Range("D" & Lr1).Value >= 0.0833 And Sheets("Training Log").Range("D" & Lr1).Value < 0.1249 Then
       Sheets("Training Log").Range("D" & Lr1).Resize(, 1).Interior.Color = RGB(255, 204, 153)
    End If
 
    If Sheets("Training Log").Range("D" & Lr1).Value >= 0.125 And Sheets("Training Log").Range("D" & Lr1).Value < 0.1458 Then
       Sheets("Training Log").Range("D" & Lr1).Resize(, 1).Interior.Color = RGB(191, 191, 191)
    End If
 
    If Sheets("Training Log").Range("D" & Lr1).Value >= 0.1459 And Sheets("Training Log").Range("D" & Lr1).Value < 0.1665 Then
       Sheets("Training Log").Range("D" & Lr1).Resize(, 1).Interior.Color = RGB(255, 204, 0)
    End If
 
    If Sheets("Training Log").Range("D" & Lr1).Value >= 0.1667 Then
       Sheets("Training Log").Range("D" & Lr1).Resize(, 1).Interior.Color = RGB(242, 242, 242)
    End If
    End If
 
    If Target.Column = 3 And Target.Row = Range("A" & Rows.Count).End(xlUp).Row Then
    Lr3 = Target.Row
    If Sheets("Training Log").Range("C" & Lr3).Value >= 9.9 And Sheets("Training Log").Range("C" & Lr3).Value < 13.2 Then
       Sheets("Training Log").Range("C" & Lr3).Interior.Color = RGB(255, 204, 153)
    End If
 
    If Sheets("Training Log").Range("C" & Lr3).Value >= 13.2 And Sheets("Training Log").Range("C" & Lr3).Value < 15.1 Then
       Sheets("Training Log").Range("C" & Lr3).Interior.Color = RGB(191, 191, 191)
    End If
 
    If Sheets("Training Log").Range("C" & Lr3).Value >= 15.1 And Sheets("Training Log").Range("C" & Lr3).Value < 17 Then
       Sheets("Training Log").Range("C" & Lr3).Interior.Color = RGB(255, 204, 0)
    End If
 
    If Sheets("Training Log").Range("C" & Lr3).Value >= 17 Then
       Sheets("Training Log").Range("C" & Lr3).Interior.Color = RGB(242, 242, 242)
    End If
    End If

End If

What does your data look like?
Click to expand...
Please see above cells, Cols A:D.

What exactly are you doing to fire off the code (what cell are you updating with what)?
Click to expand...
I am inputting a number into Col C.

What is your desired result?
Click to expand...
Cell fill conditional upon number value

What is actually happening, if anything?
Click to expand...
Col D: cell filled as desired. Col C: Nothing. No VBA error either. (Code relating to Sheet 'Iron Man Log' works perfectly)
 
Last edited:
Upvote 0
Yes, it looks like you still have an "End If" in the wrong place, meaning your second block will never be triggered.
You need to completely close out the BLOCK 1 IF...THEN blocks before starting BLOCK 2.

Try this:
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

'***BLOCK 1***
If Target.Column = 4 And Target.Row = Range("A" & Rows.Count).End(xlUp).Row Then
    
    Lr1 = Target.Row
    
    If Sheets("Training Log").Range("D" & Lr1).Value >= 0.0833 Then
        Lr2 = Sheets("Iron Man Log").Range("A" & Rows.Count).End(xlUp).Row + 1
        Sheets("Iron Man Log").Range("A" & Lr2).Value = Sheets("Training Log").Range("A" & Lr1).Value  'date
        Sheets("Iron Man Log").Range("B" & Lr2).Value = Sheets("Training Log").Range("C" & Lr1).Value  'distance
        Sheets("Iron Man Log").Range("C" & Lr2).Value = Sheets("Training Log").Range("D" & Lr1).Value  'time
    End If
    
    If Sheets("Training Log").Range("D" & Lr1).Value >= 0.0833 And Sheets("Training Log").Range("D" & Lr1).Value < 0.1249 Then
       Sheets("Training Log").Range("D" & Lr1).Resize(, 1).Interior.Color = RGB(255, 204, 153)
    End If
    
    If Sheets("Training Log").Range("D" & Lr1).Value >= 0.125 And Sheets("Training Log").Range("D" & Lr1).Value < 0.1458 Then
       Sheets("Training Log").Range("D" & Lr1).Resize(, 1).Interior.Color = RGB(191, 191, 191)
    End If
    
    If Sheets("Training Log").Range("D" & Lr1).Value >= 0.1459 And Sheets("Training Log").Range("D" & Lr1).Value < 0.1665 Then
       Sheets("Training Log").Range("D" & Lr1).Resize(, 1).Interior.Color = RGB(255, 204, 0)
    End If
    
    If Sheets("Training Log").Range("D" & Lr1).Value >= 0.1667 Then
       Sheets("Training Log").Range("D" & Lr1).Resize(, 1).Interior.Color = RGB(242, 242, 242)
    End If

End If
    
'***BLOCK 2***
If Target.Column = 3 And Target.Row = Range("A" & Rows.Count).End(xlUp).Row Then
    
    Lr3 = Target.Row
    
    If Sheets("Training Log").Range("C" & Lr3).Value >= 9.9 And Sheets("Training Log").Range("C" & Lr3).Value < 13.2 Then
        Sheets("Training Log").Range("C" & Lr3).Interior.Color = RGB(255, 204, 153)
    End If
    
    If Sheets("Training Log").Range("C" & Lr3).Value >= 13.2 And Sheets("Training Log").Range("C" & Lr3).Value < 15.1 Then
        Sheets("Training Log").Range("C" & Lr3).Interior.Color = RGB(191, 191, 191)
    End If
    
    If Sheets("Training Log").Range("C" & Lr3).Value >= 15.1 And Sheets("Training Log").Range("C" & Lr3).Value < 17 Then
        Sheets("Training Log").Range("C" & Lr3).Interior.Color = RGB(255, 204, 0)
    End If
    
    If Sheets("Training Log").Range("C" & Lr3).Value >= 17 Then
        Sheets("Training Log").Range("C" & Lr3).Interior.Color = RGB(242, 242, 242)
    End If
    
End If

End Sub
 
Upvote 0
Solution
Ahhh thanks Joe, you nailed it, it all works perfectly now, many thanks!
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question
Current Code taking 10 Hours to run. Need Help to Optimize
Replies
5
Views
290
ItalianPlatinum
I
Ironman
  • Solved
Combining 2 worksheet change events into 1
Replies
7
Views
461
Joe4
Joe4
H
  • Solved
Macro to display message end of Code where Col D contains blanks
Replies
7
Views
348
howard
H
A
  • Question
VBA if a row is all blank in a range of columns, highlight the blanks and the headers
2 3 4
Replies
31
Views
581
AnnAnn
A
Ironman
  • Question
Review of Application.EnableEvents = False/True lines in worksheet_change event
Replies
1
Views
2K
jasonb75
J

Forum statistics

Threads
1,215,488
Messages
6,125,092
Members
449,206
Latest member
ralemanygarcia

Share this page

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