Highlight Dynamic Rows

Hi All,

I have an issue where I need to highlight all columns which have a SAT or SUN as date.

I can do that ok, but if I insert a new row for another product everything is out of whack due to hard coding.

But I don;t know where to start to address this issue.

Can anybody steer me in the correct direction.

I have attached a workbook as to what I have done so far.

Thanks

Lionel

Perhaps this way. I have used Text function to arrive the day and used conditional formatting to highlight the holidays. See the attachment.

You can select ranges and clear the conditional formatting from there. I would suggest to use excel's built in features if that helps. See the attachment. I have removed the text function also

Select the area under dates (exluding the rows you want to spare) and run the below macro

Sub ToHighlight()
  Dim OneCell As Range
  For Each OneCell In Selection.Cells
     If IsDate(Cells(5, OneCell.Column)) Then
        If Format(Cells(5, OneCell.Column), "ddd") = "Sat" Or Format(Cells(5, OneCell.Column), "ddd") = "Sun" Then
           OneCell.Interior.ColorIndex = 20
        Else
           OneCell.Interior.ColorIndex = xlNone
        End If
     End If
  Next OneCell
End Sub

if your date is not in 5th row then chnage the below

Cells(5,

to your requirement

Sub snb()
 For Each ar In Sheets("Work 1").Columns(8).SpecialCells(2).Areas
  For j = 0 To Sheets("Work 1").Cells(5, Columns.Count).End(xlToLeft).Column Step 7
   ar.Offset(, j + (7 - Weekday(Sheets("Work 1").Cells(5, 10), 2)) + 1).Resize(, 2).Interior.ColorIndex = 14
  Next
 Next
End Sub

or

Sub snb_001()
 With Sheets("Work 1")
   For j = 0 To .Cells(5, Columns.Count).End(xlToLeft).Column Step 7
     With .Columns(8).SpecialCells(2).Offset(, j + (7 - Weekday(.Cells(5, 10), 2)) + 1)
       .Interior.ColorIndex = 12
       .Offset(, 1).Interior.ColorIndex = 12
     End With
   Next
 End With
end sub

That was a typical snb approach . Fewer codes and better solution! Adding to my learning

Tried all three but, Oh! not really doing the job.

The code is doing the job you presented.

Proper designing precedes coding.

Hi Lionel
I'm not certain I understand the issue but, based on my understanding, try this:
In Sheet1 Module place this code

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    If Target.Address = "$J$5" Then
        Call cmdSAT_SUN_Click
    End If
End Sub

Replace your cmdSAT_SUN_Click code with this

Option Explicit
Sub cmdSAT_SUN_Click()
    Dim wsActive As Worksheet, rngDay As Range, c As Range
    Dim LastCol As Integer, strDate As String
    Dim LR As Long
    If ActiveSheet.Name = "TEMPLATE" Then Exit Sub
    Set wsActive = ActiveSheet
    With wsActive
        LastCol = .Cells(5, .Columns.Count).End(xlToLeft).Column    'Row 5
        LR = .Cells.Find("*", .Cells(Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row
        .Range(.Cells(5, 10), Cells(LR, LastCol)).Interior.TintAndShade = 0
    End With
    With wsActive
        .AutoFilterMode = False
        .Range("D4:D" & LR).AutoFilter Field:=1, Operator:= _
                xlFilterNoFill
    End With
    Set rngDay = wsActive.Range("J5:" & Cells(5, LastCol).Address)
    For Each c In rngDay
        strDate = Format(c, "ddd")
        Select Case strDate
        Case Is = "Sat", "Sun"
            Range(Cells(6, c.Column), Cells(LR, c.Column)).SpecialCells(xlCellTypeVisible).Interior.Color = &HFFFFC0
        End Select
    Next c
    wsActive.AutoFilterMode = False
End Sub

See attached...let me know of issues.

Hi Lionel
Please post a workbook that includes this

Below that is various data reports

I need to see what these rows are and if they follow your shading scheme. The code I posted depends on finding the last row that needs shading applied.

One other thing

there are rows which are grey or white in between the coloured cells

I'm terribly color blind. I DO see the gray colored cells. If by white you mean NO COLOR then we're fine if you truly mean shaded white then I'm out of business...I don't see them.

Hi Lionel
I think I've got the Color thing figured out...it appears all cells are filled with white...unless they're not. Let me see your file with the various data reports below.

Hi Lionel
In your sample file Cell A275 says "Header 7". I need to find that row so, what does it say in the real world and does it ALWAYS say that?

Also to mention,
While the Header will always say MEASUREMENTS the cell address may not always be the same
But always Column A though.

Thanks
Lionel

Hi Lionel

This code is in the attached:
In 12-Mar Worksheet Module

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("D3")) Is Nothing Then
        Call cmdSAT_SUN_Click
    End If
End Sub

In a General Module

Option Explicit
Sub cmdSAT_SUN_Click()
    Dim wsActive As Worksheet
    Dim rngDay As Range
    Dim c As Range
    Dim LC As Long
    Dim strDate As String
    Dim LR As Long
    Dim myCol As Long
    Dim cel As Range

    If ActiveSheet.Name = "TEMPLATE" Then Exit Sub
    Set wsActive = ActiveSheet
    Application.ScreenUpdating = False
    With wsActive
        LC = .Cells(5, .Columns.Count).End(xlToLeft).Column    'Row 5
        LR = .Cells.Find("*", .Cells(Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row

        ' Sat & Sun Columns have moved so, find the first Column in Row 6 with a Blue Cell
        For Each cel In .Range(.Cells(6, 10), (.Cells(6, LC)))
            If cel.Interior.Color = &HFFFFC0 Then
                myCol = cel.Column
                Exit For
            End If
        Next cel

        ' Filter on Blue Cells
        On Error Resume Next    'In case there are no Blue Cells
        .Range(.Cells(4, myCol), (.Cells(LR, myCol))).AutoFilter Field:=1, Criteria1:=&HFFFFC0, _
                Operator:=xlFilterCellColor

        ' Make them all White
        .Range(.Cells(4, 10), (.Cells(LR, LC))).Offset(1, 0).SpecialCells(xlCellTypeVisible).Interior.Color = vbWhite
        .AutoFilterMode = False
        On Error GoTo 0

        ' Now filter on the White Cells
        .Range(.Cells(4, 10), (.Cells(LR, LC))).AutoFilter Field:=1, Criteria1:=RGB(255, _
                255, 255), Operator:=xlFilterCellColor
    End With

    ' Find the Sat and Sun Cells and make them Blue
    Set rngDay = wsActive.Range("J5:" & Cells(5, LC).Address)
    For Each c In rngDay
        strDate = Format(c, "ddd")
        Select Case strDate
        Case Is = "Sat", "Sun"
            Range(Cells(6, c.Column), Cells(LR, c.Column)).SpecialCells(xlCellTypeVisible).Interior.Color = &HFFFFC0
        End Select
    Next c
    wsActive.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

Let me know of issues.

Why is your alias foreverlearning ?

@snb
BIG Smile...

Hi Lionel
Not a "legend"...simply looked for a connection. For your benefit, ALWAYS post a workbook that truly represents your ACTUAL file, down to the last format detail. Makes things easier to find connections and saves rewrites.

snb is quite brilliant...well beyond my expertise and understanding...I got a rather large smile from his question...I too, with the Grace of God, am "Forever Learning".

Hi Lionel
You're welcome...glad I could help.