• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 82
  • Last Modified:

Creating a calendar with horizontal bar for time duration

First this isn't exactly a Gantt chart. Plenty of examples but not specifically what I am looking for.

Row 1 would display dates (F1(1/1/2015 for example) to never ending)

Row 3 (C3 Start date, C4 end date, and C5 Duration, which is C4-C3) The rows would also be limitless

Is there a way that the start date could find a matching date in row 1 and the intersection (cell) would be filled in then the number of duration would fill, horizontally, the remaining cells? If the duration is 3 days then 3 cells are filled in.

Thank you for any assistance
0
dgd1212
Asked:
dgd1212
  • 4
  • 2
  • 2
2 Solutions
 
Martin LissRetired ProgrammerCommented:
Can you manually create a small sample worksheet that shows your desired result?
0
 
dgd1212Author Commented:
Martin,
Per your request I have attached spreadsheet. I manually entered the filled in cells, which I hope to be the final result of picking dates.
Thank you for looking at this.TEST-Rolling-Calendar.xlsx
0
 
Martin LissRetired ProgrammerCommented:
Would a macro that creates/updates the "bars" when the duration changes be acceptable?
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
Martin LissRetired ProgrammerCommented:
The attached workbook contains the following macro which is called when the duration changes.  

Sub CreateBars()
Dim lngLastRow As Long
Dim lngRow As Long
Dim lngLastCol As Long
Dim lngCol As Long

With Sheets("CALENDAR")
    Application.ScreenUpdating = False
    
    lngLastRow = .Range("A1048576").End(xlUp).Row
    lngLastCol = .Cells.Find("*", SearchOrder:=xlByColumns, LookIn:=xlValues, SearchDirection:=xlPrevious).Column
    
    ' Clear the bars (the "Split(Cells(1, lngLastCol).Address, "$")(1)" part
    ' converts the column number into a letter)
    .Range("F3:" & Split(Cells(1, lngLastCol).Address, "$")(1) & lngLastRow).Interior.TintAndShade = 0
    
    For lngRow = 3 To lngLastRow
        ' Check duration
        If Val(.Cells(lngRow, 5)) > 0 Then
            For lngCol = 6 To lngLastCol
                ' Check to see if the cell's date falls between the
                ' start and stop values inclusive
                If .Cells(1, lngCol) >= .Cells(lngRow, 3) And _
                   .Cells(1, lngCol) <= .Cells(lngRow, 4) Then
                   .Cells(lngRow, lngCol).Interior.Color = vbBlack
                End If
            Next
        End If
    Next
    
    Application.ScreenUpdating = True
    
End With

End Sub

Open in new window

Q-28586739.xlsm
0
 
Ejgil HedegaardCommented:
Or use conditional formatting with this rule in F1 for the range F:XFD
=AND($C1<=F$1,$D1>=F$1,F$1<>"")
TEST-Rolling-Calendar-cond-format.xlsx
0
 
dgd1212Author Commented:
Both solutions worked. Not sure if one is more advantageous than the other but both function as needed. Many thanks for your help.
0
 
Martin LissRetired ProgrammerCommented:
If you use the Conditional formatting approach I believe you'll have to update it if you add more dates, but in any case you're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2014
0
 
Ejgil HedegaardCommented:
It is not needed to update the conditional format when more dates are added in row 1, or columns C and D.
The rule is set for all rows, and all columns from F to the last column on the sheet XFD.
Also clears the cell colour when input are deleted.
The last rule F$1<>"" ensures that cells with no date in row 1, does not turn black when comparing to empty cells in columns C and D.
If you want the rule to require data in column A and B also, change to
=AND($A1<>"",$B1<>"",$C1<=F$1,$D1>=F$1,F$1<>"")
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

  • 4
  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now