Project Plan with Gantt Chart and Resources Management

Gorgey · Sep 22nd 2014

Dear Ozgriders, this is my first post to this forum. I have been looking for some macros to help improving my project plan, but none of the examples I found did quite exactly what I was looking for.

As explained and illustrated in the enclosed spreadsheet, I am trying to build a project plan in Excel. My plan is becoming quite large (300 rows by 900+ columns) and heavy (>3MB). In order to keep track of the project plan (Gantt chart) and of the resources (people) I currently use "IF" formulas and conditional formatting. This works well for a small table, as shown in the enclosed example, but it becomes quite slow for a 300x900 matrix. Therefore I would like to streamline and speed-up this process by using macros.

Can you help me and show me macros that could do the trick?
I imagine some of you have already built similar project plans in Excel?

Thanks a lot in advance for sharing your knowledge!
Kind regards,

Greg

Gizzmo · Sep 23rd 2014

Re: Project Plan with Gantt Chart and Resources Management

Hi Gorgey,

Welcome to Ozgrid,

See the attached file. I believe I have managed to answer most of your "With the help of a macro" questions which I have highlighted in Green those that I believe the macro takes care of.

Please note the following:
1. I have inserted named ranges Date_Current and Gantt_Range, these are used by the macro so you will need to add to your working file and adjust range accordingly.
2. The Interior Color is set by the macro based on the Interior Color of Cells in Column B.
3. The Macro is intended to run on Sheet Named "Sheet 1 (2)" you will need to adjust the macro if you change the sheet name.

Hope this helps you.

Gorgey · Sep 23rd 2014

Re: Project Plan with Gantt Chart and Resources Management

Thanks a lot Gizzmo for your quick reply and for the great help!

Your macro is indeed answering most of my questions. If I am correct this macro does not run automatically (which may actually be nice in order to keep the file and the process as light as possible). I will then add a button to be able to manually update the Gantt chart. Would it be possible to run this macro automatically at least once, e.g. at start up or while closing the file?

Regarding the colors, this works very well as well! The colors in the "date" table were however different to the colors in column B. I found out that replacing "Interior.ColorIndex" by "Interior.Color" ensures that colors remain unaltered. Is this the right solution?

I will definitely apply this macro to my large 300x900 spreadsheet. I am quite sure it will dramatically reduce the size of my file and improve the overall usability.

Thanks again for your help!

Greg

**cytop** · Sep 23rd 2014

Re: Project Plan with Gantt Chart and Resources Management

Quote

...Would it be possible to run this macro automatically

Can't view the workbook but you could call the macro in the Workbook_Open event of the ThisWorkBook class module. That'll update it when the workbook is opened.

Gizzmo · Sep 24th 2014

Re: Project Plan with Gantt Chart and Resources Management

Quote from Gorgey;727109

Would it be possible to run this macro automatically at least once, e.g. at start up or while closing the file?

Yes, I would do as per cytop reply. just add the following code should do it (see attached file)

Code

Private Sub Workbook_Open()
    Call UpDateGantt
End Sub

Quote from Gorgey;727109

Regarding the colors, this works very well as well! The colors in the "date" table were however different to the colors in column B. I found out that replacing "Interior.ColorIndex" by "Interior.Color" ensures that colors remain unaltered. Is this the right solution?

It works so it is a solution, as for if it is the right solution, I can't really say. Sorry I am not trying to be funny but I do not know enough about excel/vba to give an expert answer. Perhaps the 'experts' could give some advise.

I am glad I was able to help out. I have attached revised file with some changes refer to Worksheet Change Event and additionaol named ranges etc to handle Adding Names to the Responsible List and set interior colors as well as amended formula to handle Total by resource

Gorgey · Sep 24th 2014

Re: Project Plan with Gantt Chart and Resources Management

Hi Gizzmo,

Thanks for the update macro! I slightly changed the code to make sure only the current date in the "date table" is colored.
I also expanded the plan to 2 years (+/- 700 columns) and to about 80 rows to see how quickly the macro could do its magic. Unfortunately is does take some time (more than what I hoped). Is there any other trick that could be consider to speed up the update?

(For some reason I cannot upload this new and larger project plan, sorry).

Kind regards,

Greg

Gizzmo · Sep 25th 2014

Re: Project Plan with Gantt Chart and Resources Management

Quote from Gorgey;727224

Is there any other trick that could be consider to speed up the update?

This is probably not the best solution but try amending Worksheet_Change to...

Code

Private Sub Worksheet_Change(ByVal Target As Range)


    Dim myValue As String
    Dim myAddress As Range
    Dim rng As Range
    Dim r As Range
    Dim Lastrow As Long
    Dim Lastcol As Long
    Dim myRow As String
    Dim ColLtr As String
    
    If Not Intersect(Target, Range("Responsible_TargetRange")) Is Nothing Then
    myValue = Target.Address


        If Target.Address = "$B$1" Then
        
        Call UpDateGantt
        
        Else
    
            Range(Target.Address).Interior.Color = Range("Responsible_List").Find(What:=Target, LookAt:=xlWhole).Interior.Color
        
            myRow = Range(Target.Address).Row 'Range(Target.Address).End(xlToLeft).Address(False, False)
        
            ColLtr = Replace(Range("XFD3").End(xlToLeft).Address(False, False), 3, "")
        
            Lastrow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
            Lastcol = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
        
            Set rng = Sheets("Sheet1 (2)").Range("K" & myRow & ":" & ColLtr & myRow)
        
            'rng.Select
        
            For Each r In rng
        
            Dim StartDate As Date
            Dim EndDate As Date
            Dim PlanDate As Date
            Dim CurrentDate As Date
            Dim myPerson As String
        
            StartDate = Range("I" & Range(r.Address).Row).Value
            EndDate = Range("J" & Range(r.Address).Row).Value
            ColLtr = Replace(Range(r.Address).Address(False, False), Range(r.Address).Row, "")
            PlanDate = Range(ColLtr & 3).Value
            myPerson = Left(Range("B" & Range(r.Address).Row).Value, 1)
        
            If PlanDate >= StartDate And PlanDate <= EndDate Then
        
            r.Value = myPerson
            r.NumberFormat = "General"
            r.Interior.Color = Range("B" & Range(r.Address).Row).Interior.Color
        
                If PlanDate = Range("Date_Current").Value Then
                    Range(ColLtr & 3).Offset(0, -1).Interior.ColorIndex = xlColorIndexNone
                    Range(ColLtr & 3).Offset(0, 1).Interior.ColorIndex = xlColorIndexNone
                    Range(ColLtr & 3).Interior.Color = Range("Date_Current").Interior.Color
                    r.Interior.Color = Range("Date_Current").Interior.Color
                    Else
                        'Range(ColLtr & 3).Interior.ColorIndex = xlColorIndexNone
                End If
        
                Else
                r.Value = ""
                r.NumberFormat = "General"
                r.Interior.ColorIndex = xlColorIndexNone
        
                    If PlanDate = Range("Date_Current").Value Then
                    Range(ColLtr & 3).Offset(0, -1).Interior.ColorIndex = xlColorIndexNone
                    Range(ColLtr & 3).Offset(0, 1).Interior.ColorIndex = xlColorIndexNone
                    Range(ColLtr & 3).Interior.Color = Range("Date_Current").Interior.Color
                    r.Interior.Color = Range("Date_Current").Interior.Color
                    Else
                        'Range(ColLtr & 3).Interior.ColorIndex = xlColorIndexNone
                    End If
        
            End If
        
            Next r


        End If
    End If
End Sub

Display More

This will only change/update the row in which the 'Responsible' resource has been changed.

Howver if the Current Date is changed it will still Call the UpDateGantt macro so that the Current Date is highlighted correctly

Code

Sub UpDateGantt()




    'Get current state of various Excel settings


    screenUpdateState = Application.ScreenUpdating


    statusBarState = Application.DisplayStatusBar


    calcState = Application.Calculation


    eventsState = Application.EnableEvents


    displayPageBreakState = ActiveSheet.DisplayPageBreaks 'note this is a sheet-level setting


    'turn off some Excel functionality so your code runs faster


    Application.ScreenUpdating = False


    Application.DisplayStatusBar = False


    Application.Calculation = xlCalculationManual


    Application.EnableEvents = False


    ActiveSheet.DisplayPageBreaks = False 'note this is a sheet-level setting


    Dim rng As Range
    Dim r As Range
    Dim Lastrow As Long
    Dim Lastcol As Long
    Dim myRow As String
    Dim ColLtr As String


    myRow = Range("XFD3").End(xlToLeft).Address(False, False)


    ColLtr = Replace(Range("XFD3").End(xlToLeft).Address(False, False), "3", "")


    Lastrow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
    Lastcol = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column


    Set rng = Range("Gantt_Range") 'Intersect(Range("K4:" & ColLtr & Lastcol), Sheets("Sheet1 (2)").UsedRange)


'    rng.Select


    For Each r In rng


    Dim StartDate As Date
    Dim EndDate As Date
    Dim PlanDate As Date
    Dim CurrentDate As Date
    Dim myPerson As String


    StartDate = Range("I" & Range(r.Address).Row).Value
    EndDate = Range("J" & Range(r.Address).Row).Value
    ColLtr = Replace(Range(r.Address).Address(False, False), Range(r.Address).Row, "")
    PlanDate = Range(ColLtr & 3).Value
    myPerson = Left(Range("B" & Range(r.Address).Row).Value, 1)


    If PlanDate >= StartDate And PlanDate <= EndDate Then


    r.Value = myPerson
    r.NumberFormat = "General"
    r.Interior.Color = Range("B" & Range(r.Address).Row).Interior.Color


        If PlanDate = Range("Date_Current").Value Then
            Range(ColLtr & 3).Offset(0, -1).Interior.ColorIndex = xlColorIndexNone
            Range(ColLtr & 3).Offset(0, 1).Interior.ColorIndex = xlColorIndexNone
            Range(ColLtr & 3).Interior.Color = Range("Date_Current").Interior.Color
            r.Interior.Color = Range("Date_Current").Interior.Color
            Else
                'Range(ColLtr & 3).Interior.ColorIndex = xlColorIndexNone
        End If


        Else
        r.Value = ""
        r.NumberFormat = "General"
        r.Interior.ColorIndex = xlColorIndexNone


            If PlanDate = Range("Date_Current").Value Then
            Range(ColLtr & 3).Offset(0, -1).Interior.ColorIndex = xlColorIndexNone
            Range(ColLtr & 3).Offset(0, 1).Interior.ColorIndex = xlColorIndexNone
            Range(ColLtr & 3).Interior.Color = Range("Date_Current").Interior.Color
            r.Interior.Color = Range("Date_Current").Interior.Color
            Else
                'Range(ColLtr & 3).Interior.ColorIndex = xlColorIndexNone
            End If


    End If


    Next r


    'after your code runs, restore state


    Application.ScreenUpdating = screenUpdateState


    Application.DisplayStatusBar = statusBarState


    Application.Calculation = calcState


    Application.EnableEvents = eventsState


    ActiveSheet.DisplayPageBreaks = displayPageBreaksState 'note this is a sheet-level setting


End Sub

Display More

There is probably a more refined way to do this, perhaps try asking the rest of the Forum to either refine this code or come up with a better way. I have noticed that "jindon" has provided some better more refined solutions to some of my past posts perhaps see if he/she is willing to help.

Project Plan with Gantt Chart and Resources Management

Participate now!

Share