Cell value to calendar instead of highlight

[farmerkzhel]

I have a leave calendar which is highlighting as per the start and end dates using conditional formatting formula
=SUMPRODUCT((B3<=$I$19:$I$150)*(B3>=$E$19:$E$150))=1
I want to show name mentioned in cell in front of start date and end date instead of Green highlight in calendar attaching a picture to have a clear view

 

[RickXL]

Hi and welcome to the MrExcel Message Board.

Here is one possibility without using VBA:

Worksheet Formulas Cell Formula B3 =IFERROR(INDEX($A$20:$A$150,MATCH(DATEVALUE(B$2 & " " & $A3 & " " & $D$1),$E$20:$E$150,0),1),"") <thead> </thead><tbody> </tbody>

<tbody>
</tbody>

The Conditional Formatting formula is now:

=SUMPRODUCT((DATEVALUE(B$2 & " " & $A3 & " " & $D$1)<=$I$19:$I$150)*(DATEVALUE(B$2 & " " & $A3 & " " & $D$1)>=$E$19:$E$150))=1

I changed the format to hide the grid lines so the bar looks continuous.

Basically, instead of having a date in every cell I am now looking up the date using DATEVALUE and the year from D1 the months in column A and the days in row 3.

This leaves the individual cells empty so I can add a formula in there to find the name and insert it into the first cell.

If you turned the calendar round sideways you could accomodate longer names.

If two people have a holiday on the same date something has got to give!

 

[farmerkzhel]

Thanks RickXL i use this formula after deleting all the conditional formatting it is working as per my requirements but only problem is if i have two people on same date or date range is possible to display them like (ABC/ZZZ/XYZ) if duplicate
i use this formula in Cell B3

"=IFERROR(INDEX($A$20:$A$151,MATCH(1,IF(DATE($D$1,ROWS($A$3:$A3),B$2)>=$B$20:$B$151,IF(DATE($D$1,ROWS($A$3:$A3),B$2)<=$C$20:$C$151,1)),0)),"")"

Please let me know if formula option or Excel VBA available preferably EXcel VBA if possible

 

[farmerkzhel]

Any Idea about VLook i don know how to apply on this one

Hi and welcome to the MrExcel Message Board.

Here is one possibility without using VBA:

Worksheet Formulas Cell Formula B3 =IFERROR(INDEX($A$20:$A$150,MATCH(DATEVALUE(B$2 & " " & $A3 & " " & $D$1),$E$20:$E$150,0),1),"") <tbody> </tbody>

<tbody>
</tbody>

The Conditional Formatting formula is now:

=SUMPRODUCT((DATEVALUE(B$2 & " " & $A3 & " " & $D$1)<=$I$19:$I$150)*(DATEVALUE(B$2 & " " & $A3 & " " & $D$1)>=$E$19:$E$150))=1

I changed the format to hide the grid lines so the bar looks continuous.

Basically, instead of having a date in every cell I am now looking up the date using DATEVALUE and the year from D1 the months in column A and the days in row 3.

This leaves the individual cells empty so I can add a formula in there to find the name and insert it into the first cell.

If you turned the calendar round sideways you could accomodate longer names.

If two people have a holiday on the same date something has got to give!

 

[RickXL]

There are lots of things that can be done. However, you need to put some thought into your requirements first.

You need to think about how many names you want to display in the same cell. Then think how big the cells will actually be. Would that work? Suppose everyone has New Year's Eve as holiday, for instance.
How would you indicate if more than one person started holidays of different lengths on the same day. How would you want them differentiating?

There are other options, including:
Turn the chart round 90 degrees and put the months across the top. That will provide several times the current column width. Would that be enough?
You could use comments - would that help? Perhaps use comments if more than one name needs to be assigned to a day.
If you selected a cell you could make VBA highlight the relevant rows in the table below with the names and dates in it.

 

[farmerkzhel]

@RickXL They are shift workers so no public holidays if they are off they will be off otherwise working. and MAX 3 people can go on leave same dates so max 3 initials in one cell as per date range eg
ABC(1 Jan to 5 Jan) DEF(3 Jan to 6 Jan) and XYZ(2 Jan to 7 Jan)
So In Cell for January 1 ABC
In Cell for January 2 ABC/XYZ
In Cell for January 3 ABC/DEF/XYZ up to jan 5
In Cell for January 6 DEF/XYZ
In Cell for January 7 XYZ

That is what i want column width and height doesn't matter only want that data to be displayed on the calendar on respective dates range

Thanks and much appreciated if you can give some Formula/Solution

 

[RickXL]

Try this:

' Colour Palette: http://dmcritchie.mvps.org/excel/colors.htm

Sub Refresh_Calendar()

    Dim lst     As Variant
    Dim i       As Long
    Dim j       As Long
    Dim M       As Long
    Dim D       As Long
    Dim nam     As Variant
    Dim col     As Variant
    Dim ThisYr  As Long
    
    ReDim nam(1 To 12, 1 To 31)
    ReDim col(1 To 12, 1 To 31)
    
    With ThisWorkbook.Worksheets("Sheet2")
        ThisYr = .Range("D1").Value
    End With
    
    With ThisWorkbook.Worksheets("Sheet2")
        lst = .Range("A20:I" & .Cells(.Rows.Count, "A").End(xlUp).Row)
    End With
    
    For i = 1 To UBound(lst)
        For j = lst(i, 5) To lst(i, 9)
            If Year(j) = ThisYr Then
                M = Month(j)
                D = Day(j)
                col(M, D) = col(M, D) + 1
            End If
        Next
    Next
    
    For i = 1 To UBound(lst)
        j = lst(i, 5)
        If Year(j) = ThisYr Then
            M = Month(j)
            D = Day(j)
            nam(M, D) = nam(M, D) & IIf(nam(M, D) = "", "", "/") & lst(i, 1)
        End If
    Next
    
    With ThisWorkbook.Worksheets("Sheet2")
        Application.ScreenUpdating = False
        .Range("B3").Resize(12, 31) = nam
        
        For M = 1 To 12
            For D = 1 To 31
                With .Cells(M, D).Offset(2, 1).Interior
                    If col(M, D) > 0 Then .ColorIndex = 42 + col(M, D) Else .ColorIndex = xlNone
                    If Month(DateSerial(ThisYr, M, D)) <> M Then .ColorIndex = 1
                End With
            Next
        Next
        Application.ScreenUpdating = True
    End With

End Sub

The code needs to be pasted into a standard macro Module in the VB Editor.
Personally, I don't like having the list of dates and names on the same sheet as the calendar display because it makes the formatting difficult. So I have written the code so that it will be easy to change to using two sheets. You could make activation of the first sheet automatically update the calendar as well.
The date in D4 is dynamic. That is, you can have more than one year's worth of dates in the list and changing the date and running the macro will change the display - including making the February/leap year change.

The operation is basically in two parts: one notes if anyone is away on that day and the other adds initials to the start date.

The array that contains the colour information is called col and that contains a number showing the number of people away. I used that to change the colour of the bar in the chart but you can change that to be the same colour all the time if you wish.
The

If Month(DateSerial(ThisYr, M, D)) <> M Then .ColorIndex = 1

line is the one that adds the black colour to mark the shorter months.

I used Sheet2 so you may need to overtype that.

 

[RickXL]

Sorry, I couldn't leave it alone. I am answering my own questions now.

I changed the formatting, moved the date list to another sheet, moved the cell with the year in it and added a spin button for changing the year.
Also, I made it so that after you have added some more dates, when you swap back to the Calendar it will update the display.

Sub Refresh_Calendar2()

    Dim lst     As Variant
    Dim i       As Long
    Dim j       As Long
    Dim M       As Long
    Dim D       As Long
    Dim nam     As Variant
    Dim col     As Variant
    Dim ThisYr  As Long
    
    ReDim nam(1 To 12, 1 To 31)
    ReDim col(1 To 12, 1 To 31)
    
    With ThisWorkbook.Worksheets("Calendar")
        ThisYr = .Range("A1").Value
    End With
    
    With ThisWorkbook.Worksheets("Leave Requests")
        lst = .Range("A2:C" & .Cells(.Rows.Count, "A").End(xlUp).Row)
    End With
    
    For i = 1 To UBound(lst)
        For j = lst(i, 2) To lst(i, 3)
            If Year(j) = ThisYr Then
                M = Month(j)
                D = Day(j)
                col(M, D) = col(M, D) + 1
            End If
        Next
    Next
    
    For i = 1 To UBound(lst)
        j = lst(i, 2)
        If Year(j) = ThisYr Then
            M = Month(j)
            D = Day(j)
            nam(M, D) = nam(M, D) & IIf(nam(M, D) = "", "", "/") & lst(i, 1)
        End If
    Next
    
    With ThisWorkbook.Worksheets("Calendar")
        Application.ScreenUpdating = False
        .Range("B3").Resize(12, 31) = nam
        
        For M = 1 To 12
            For D = 1 To 31
                With .Cells(M, D).Offset(2, 1).Interior
                    If col(M, D) > 0 Then .ColorIndex = 42 + col(M, D) Else .ColorIndex = xlNone
                    If Month(DateSerial(ThisYr, M, D)) <> M Then .ColorIndex = 1
                End With
            Next
        Next
        Application.ScreenUpdating = True
    End With

End Sub

The following two event handlers need to be pasted in to the Sheet Module for the Calendar worksheet:

Private Sub SpinButton1_Change()
    Range("A1") = SpinButton1.Value
    Call Refresh_Calendar2
End Sub

Private Sub Worksheet_Activate()
    Call Refresh_Calendar2
End Sub

A sample of the Leave Requests sheet follows (NB: I have data for a ten year period in there):

Excel 2013
	A	B	C
1	Name	Start date	End date
2	ADW	15/06/2011	24/06/2011
3	MTB	23/03/2010	25/03/2010
4	MHO	05/01/2011	14/01/2011
5	EQZ	10/04/2016	14/04/2016
6	GWD	28/07/2013	06/08/2013
7	DBP	22/06/2011	22/06/2011
8	EGI	07/11/2015	14/11/2015
9	USM	14/08/2013	21/08/2013
10	KGI	15/11/2014	15/11/2014
11	VOX	04/11/2016	13/11/2016
12	TEA	17/07/2018	26/07/2018
Leave Requests