Highlight a cell if it falls between 2 values on the worksheet AND text in another cell is x

[ffc2004]

Hi all,

I have a worksheet set up with dates that an area is booked for, and a calendar set up on the same sheet. Currently I've got it highlighting the date on the calendar if the date is entered on the worksheet by conditional formatting if values are between cell x and cell y, but what I would like to do is only highlight the date if they fall between these ranges AND cell z contains specific text. eg if cell O11 contains "Heath" then it would highlight the dates from J11-K11 on the calendar. Can this be done?

https://ibb.co/mhMhF3j is how it currently looks, I've tried <code style="margin: 0px; padding: 1px 5px; border: 0px; font-variant-numeric: inherit; font-variant-east-asian: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; background-color: rgb(239, 240, 241); white-space: pre-wrap; color: rgb(36, 39, 41);">=IF($A$12=$O$11,AND(B11>=$J$11,B11<=$K$11))</code> but it only seems to work for the first row of dates.

 

[Scott T]

I was not able to get the code to work setting a specific color could only get it to work with the preset styles. You can play around with the different styles to see which one works best.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A12")) Is Nothing Then
    Dim cell As Range
    Dim mrng As Range
    Dim loc As Range
    Dim rcount As Long
    Dim mGrpObj As GroupObject
    Dim mshape As Shape
    
    Set mrng = Range("B11:H15")
    Set loc = Range("A12")
    rcount = Cells(11, "J").End(xlDown).Row
    For Each mGrpObj In ThisWorkbook.Worksheets("Sheet2").GroupObjects
        For Each mshape In mGrpObj.ShapeRange.GroupItems
            mshape.BackgroundStyle = msoBackgroundStylePreset7 'change 7 to change the style
        Next mshape
    Next mGrpObj
    
    
    For Each mGrpObj In ThisWorkbook.Worksheets("Sheet2").GroupObjects
        For Each mshape In mGrpObj.ShapeRange.GroupItems
            For x = 11 To rcount
                mdate = mshape.TextFrame.Characters.Text
                If mdate <> "" Then
                    If Cells(x, "O") = loc And DateValue(mdate) >= Cells(x, "J") And DateValue(mdate) <= Cells(x, "K") Then
                        mshape.BackgroundStyle = msoBackgroundStylePreset8
                    End If
                End If
            Next x
        Next mshape
    Next mGrpObj
End If
End Sub

 

[ffc2004]

I was not able to get the code to work setting a specific color could only get it to work with the preset styles. You can play around with the different styles to see which one works best.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A12")) Is Nothing Then
    Dim cell As Range
    Dim mrng As Range
    Dim loc As Range
    Dim rcount As Long
    Dim mGrpObj As GroupObject
    Dim mshape As Shape
    
    Set mrng = Range("B11:H15")
    Set loc = Range("A12")
    rcount = Cells(11, "J").End(xlDown).Row
    For Each mGrpObj In ThisWorkbook.Worksheets("Sheet2").GroupObjects
        For Each mshape In mGrpObj.ShapeRange.GroupItems
            mshape.BackgroundStyle = msoBackgroundStylePreset7 'change 7 to change the style
        Next mshape
    Next mGrpObj
    
    
    For Each mGrpObj In ThisWorkbook.Worksheets("Sheet2").GroupObjects
        For Each mshape In mGrpObj.ShapeRange.GroupItems
            For x = 11 To rcount
                mdate = mshape.TextFrame.Characters.Text
                If mdate <> "" Then
                    If Cells(x, "O") = loc And DateValue(mdate) >= Cells(x, "J") And DateValue(mdate) <= Cells(x, "K") Then
                        mshape.BackgroundStyle = msoBackgroundStylePreset8
                    End If
                End If
            Next x
        Next mshape
    Next mGrpObj
End If
End Sub

I amended where I've had to move cells to, as below, and am getting a type mismatch on If Cells(x, "K") = loc And DateValue(mdate) >= Cells(x, "E") And DateValue(mdate) <= Cells(x, "F") Then

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F2")) Is Nothing Or Not Intersect(Target, Range("F3")) Is Nothing Then


Dim cell As Range
Dim mrng As Range
Dim loc As Range
Dim rcount As Long
Dim mGrpObj As GroupObject
Dim mshape As Shape

Set mrng = Range("B11:H15")
Set loc = Range("F3")
rcount = Cells(12, "E").End(xlDown).Row
For Each mGrpObj In ThisWorkbook.Worksheets("New Tables").GroupObjects
For Each mshape In mGrpObj.ShapeRange.GroupItems
mshape.BackgroundStyle = msoBackgroundStylePreset5 'change 7 to change the style
Next mshape
Next mGrpObj


For Each mGrpObj In ThisWorkbook.Worksheets("New Tables").GroupObjects
For Each mshape In mGrpObj.ShapeRange.GroupItems
For x = 12 To rcount
mdate = mshape.TextFrame.Characters.Text
If mdate <> "" Then
If Cells(x, "K") = loc And DateValue(mdate) >= Cells(x, "E") And DateValue(mdate) <= Cells(x, "F") Then
mshape.BackgroundStyle = msoBackgroundStylePreset8
End If
End If
Next x
Next mshape
Next mGrpObj
End If
End Sub

 

[ffc2004]

I've moved on from the text box route as it wouldn't work as needed, though thanks for trying.

What code would I use to highlight range N2:P65 if the value in T2:T65 matches A10, and dates in N2:O65 match the dates in range B9:H14?

eg A10 says "Heath", several cells in T2:T65 say "Heath" - I'd like the matching cells in T2:T65 to highlight, as well as the corresponding dates in N2:O65 from the calendar when A9 changes.

 

[Scott T]

Although you can use code to do that you do not need to as you can use conditional formatting.

Select N2:O65 and T2:T65

In conditional formatting select New Rule
Select Use a formula to determine which cells to format
use this formula

=$A$10=$T2

Select your formatting and click OK

 

[Scott T]

The VBA way

automatically when A10 is change

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A10")) Is Nothing Then
    Range("N2:O65").Interior.Color = xlNone
    Range("T2:T65").Interior.Color = xlNone
    
    For x = 2 To 65
        If Cells(x, "T") = Range("A10") Then
            Cells(x, "N").Resize(, 2).Interior.Color = vbYellow
            Cells(x, "T").Interior.Color = vbYellow
        End If
    Next x
End If
End Sub

or

have to manually run the code

Sub highl()
    Range("N2:O65").Interior.Color = xlNone
    Range("T2:T65").Interior.Color = xlNone
    For x = 2 To 65
        If Cells(x, "T") = Range("A10") Then
            Cells(x, "N").Resize(, 2).Interior.Color = vbYellow
            Cells(x, "T").Interior.Color = vbYellow
        End If
    Next x
End Sub

 

[ffc2004]

Although you can use code to do that you do not need to as you can use conditional formatting.

Select N2:O65 and T2:T65

In conditional formatting select New Rule
Select Use a formula to determine which cells to format
use this formula

=$A$10=$T2

Select your formatting and click OK

I had done this initially, but I would also like it to only highlight the January dates when A9 is January, February dates when it is February in A9, etc - data is here https://ibb.co/dDK11XM

 

[Scott T]

You can still use conditional formatting. Will the to-from dates ever cross months? That is if the date in N2 is Jan 30 and O2 is Feb 7 should it be highlighted?

 

[ffc2004]

You can still use conditional formatting. Will the to-from dates ever cross months? That is if the date in N2 is Jan 30 and O2 is Feb 7 should it be highlighted?

They will occasionally, yes.

 

[Scott T]

In A9 put in a date and format the cell to only show the month.

In conditional formatting use

=AND($A$10=$T2,MONTH($N2)=MONTH($A$9))

If you have multiple years in the list and only want the current year highlighted use

=AND($A$10=$T3,MONTH($N3)=MONTH($A$9),YEAR($A$9)=YEAR($N3))

 

[ffc2004]

That's fantastic, thank you - final one (I think!)...I have conditional formatting set up on the calendar range in B9:H14 to put a border around the current date, the only problem is that it then removes the highlighting from the VBA if there is any?