I am trying to change the interior color of cells based on the value of cell J4

J1149

New Member
Joined
Jan 20, 2007
Messages
39
I need the cells J8, J10, J12, J14 to change from a white interior to a gray pattern when the number in J4 is changed In other words when J4 changes to 2, J8 interior color changes when J4 is changed to 3 J10 then changes and the same for J12 and J14. Also in cell C4 if 5 is selected I need Cells I 16 and J16 to show with J16 interior to be white when the value is "5" in J4. When the workbook is reset for a new period I need the cells J8, J10, J12, J14 interior to be white until J4 is change from 1 to 2, etc with week 1 gray patterned. I have coded it but I cannot get week 4,5 to work properly, nor can I get the cells to change back to a white interior when the workbook is reset.
Here is my code:

Code:
Private Sub Worksheet_Activate()
        
    Me.ScrollArea = "A1:P25"
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.ScrollRow = 1
    
    If Range("J4") = 1 Then
     Range("J8").Select
    ElseIf Range("J4") = 2 Then
     Range("J10").Select
    ElseIf Range("J4") = 3 Then
     Range("J12").Select
    ElseIf Range("J4") = 4 Then
     Range("J14").Select
    ElseIf Range("J4") = 5 Then
     Range("J16").Select
    End If
'   GrossSalesCalc Macro
    ActiveCell.FormulaR1C1 = _
        "=SUM('STAGING AREA'!R[-5]C[-8],'STAGING AREA'!R[-3]C[-8],'STAGING AREA'!R[-2]C[-8],'STAGING AREA'!RC[-8])"
    Range("J10").Select
    ActiveCell.FormulaR1C1 = _
        "=SUM('STAGING AREA'!R[-7]C[-6],'STAGING AREA'!R[-5]C[-6],'STAGING AREA'!R[-4]C[-6],'STAGING AREA'!R[-2]C[-6])"
    Range("J12").Select
    ActiveCell.FormulaR1C1 = _
        "=SUM('STAGING AREA'!R[-9]C[-4],'STAGING AREA'!R[-7]C[-4],'STAGING AREA'!R[-6]C[-4],'STAGING AREA'!R[-4]C[-4])"
    Range("J14").Select
    ActiveCell.FormulaR1C1 = _
        "=SUM('STAGING AREA'!R[-11]C[-2],'STAGING AREA'!R[-9]C[-2],'STAGING AREA'!R[-8]C[-2],'STAGING AREA'!R[-6]C[-2])"
    Range("J16").Select
    ActiveCell.FormulaR1C1 = _
        "=SUM('STAGING AREA'!R[-13]C,'STAGING AREA'!R[-11]C,'STAGING AREA'!R[-10]C,'STAGING AREA'!R[-8]C)"
    Range("J17").Select
End Sub
Private Sub CheckWeek()
'
        If Range("J4").Value = 1 Then
        Range("J8").Select
            With Selection.Interior
            .ColorIndex = 2
            .Pattern = xlSolid
            End With
        Range("J10,J12,J14").Select
            With Selection.Interior
            .Pattern = xlGray50
            .PatternColorIndex = 16
            End With
        
        Range("J8").Select
'
        ElseIf Range("J4").Value = 2 Then
        Range("J10").Select
            With Selection.Interior
            .ColorIndex = 2
            .Pattern = xlSolid
            End With
        Range("J8,J12,J14").Select
            With Selection.Interior
            .ColorIndex = 2
            .Pattern = xlGray50
            .PatternColorIndex = 16
            End With
        Range("J10").Select
'
        ElseIf Range("J4").Value = 3 Then
        Range("J12").Select
            With Selection.Interior
            .ColorIndex = 2
            .Pattern = xlSolid
            End With
        Range("J8,J10,J14").Select
            With Selection.Interior
            .ColorIndex = 2
            .Pattern = xlGray50
            .PatternColorIndex = 16
            End With
        Range("J12").Select
'
        ElseIf Range("J4").Value = 4 Then
        Range("J14").Select
            With Selection.Interior
            .ColorIndex = 2
            .Pattern = xlSolid
            End With
        Range("J8,J10,J12").Select
            With Selection.Interior
            .ColorIndex = 2
            .Pattern = xlGray50
            .PatternColorIndex = 16
            End With
        
        Range("J14").Select
'
        ElseIf Range("J4").Value = 5 Then
        Range("J8,J10,J12,J14").Select
            With Selection.Interior
            .ColorIndex = 2
            .Pattern = xlGray50
            .PatternColorIndex = 16
            End With
        Range("J16").Select
            With Selection.Interior
            .ColorIndex = 2
            .Pattern = xlSolid
            End With
        End If
End Sub
Private Sub DIMWEEK()
        If Range("J4") = 5 Then
            Call ShowWeek5
        Else
            Call NOShowWeek5
        End If
         
End Sub
Private Sub ShowWeek5()
'
       Range("J16").Select
         With Selection.Interior
              .ColorIndex = 2
              .Pattern = xlGray50
              .PatternColorIndex = 16
         End With
         With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThick
            .ColorIndex = 16
        End With
         With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThick
            .ColorIndex = 16
        End With
         With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlDouble
            .Weight = xlThick
            .ColorIndex = 16
        End With
         With Selection.Borders(xlEdgeRight)
            .LineStyle = xlDouble
            .Weight = xlThick
            .ColorIndex = 16
        End With
              
End Sub
Private Sub NOShowWeek5()
'
        Range("J16").Select
        With Selection
            .Interior.ColorIndex = 15
            .Interior.Pattern = xlSolid
            .Borders(xlEdgeLeft).LineStyle = xlNone
            .Borders(xlEdgeTop).LineStyle = xlNone
            .Borders(xlEdgeBottom).LineStyle = xlNone
            .Borders(xlEdgeRight).LineStyle = xlNone
        End With
        '
End Sub
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
In your Worksheet_Activate code you are pretty much doing the same thing repeatedly, all that changes is the range you are doing it to.

If you separate this code into their own procedures you just need to send the range to process.
Rich (BB code):
Private Sub ToggleColour(ByVal CellRange As String)
   With Range(CellRange).Interior
      .ColorIndex = 2
      .Pattern = xlSolid
   End With
End Sub


Private Sub TogglePattern(ByRef CellRange As String)
   With Range(CellRange).Interior
      .ColorIndex = 2
      .Pattern = xlGray50
      .PatternColorIndex = 16
   End With
End Sub

I would use a Worksheet_Change event to trigger on J4.
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
   
   'only trigger on J4
   If Target.Address <> "$J$4" Then Exit Sub


   If Target.Value >= 1 And Target.Value <= 5 Then
   
      'disable events whilst writing to sheet, ensure they are reset on error
      On Error GoTo ResetAppEvents
      Application.EnableEvents = False
      
      Select Case Target.Value
         Case Is = 1
            ToggleColour "J8"
            TogglePattern "J10,J12,J14"
            'formula
         Case Is = 2
            ToggleColour "J10"
            TogglePattern "J8,J12,J14"
            'formula
         Case Is = 3
            ToggleColour "J12"
            TogglePattern "J8,J10,J14"
            'formula
         Case Is = 4
            ToggleColour "J14"
            TogglePattern "J8,J10,J12"
            'formula
         Case Else
            ToggleColour "J16"
            TogglePattern "J8,J10,J12, J14"
            'formula
      End Select
   End If
   
ResetAppEvents:
   Application.EnableEvents = True
End Sub

NB Note how you have to disable events when you write to the sheet.

All of the above code would go into the sheet module.
You can add your formula to the Select Case statement.
I would use the Worksheet_Active event (or Workbook.Open event) for resetting the cell formats.

Make a copy of your workbook before testing.

Hope this helps,
Bertie
 
Upvote 0
Bertie, The code works fine in a new workbook, but I must be doing something wrong when I copy it to my workbook because I keep getting an ambiguous error. I am newbie to vba so I am sure I am missing a step.
 
Upvote 0
There can only be one Worksheet_Change event per Sheet. The ambiguity sound like you already have a Worksheet_Change event.

A simple solution would be to rename my Worksheet_Change event procedure.
In the existing Worsheet_Change event:
Use an IF statement to check if the cell is J4, if so, call my code.
 
Upvote 0
That is it. I already had a change event in the sheet module. Thank you very much for the help. This completes my project. Best wishes and Happy Holidays.
 
Upvote 0

Forum statistics

Threads
1,215,492
Messages
6,125,116
Members
449,206
Latest member
burgsrus

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