NORMDIST Function

[taltyr]

I know the Budget, Duration, Start Date and End Date for a Construction Project. I want to fill cells on a Gant Chart to spread the Budget between the Start Dates and End Dates using a Normal Distribution.

So far I have managed to get VBA to loop through the cells until it reaches the Column with the correct Start Date as the heading. From there it can fill the Budget accross the correct Duration. However all I can do is to get it to spread the Budget evenly, i.e. Budget/Duration in each month. A normal distribution to spread the Budget in what would be a Bell Curve (if I was to plot it) would be a better solution. I think NORMDIST gets me in the right ball park, however, I don't know how to code it to fill the range.

Any help appreciated.

Regards

Taltyr

 

[taltyr]

I had that problem also, I got it solved on another thread. The answer lies in the use of the MATCH Function. For reference, the final code I ended up with is;

Option Explicit
Sub FillCashFlow()
' Macro Written by Rodger Talty of EC harris
' August 2011
      
     Dim Duration As Integer
     Dim Budget As Currency
     Dim MthExp As Long
     Dim Mth1 As Long
     Dim MthLast As Long
     Dim StartDate As Date
     Dim FinishDate As Date
     Dim PramA As Integer
     Dim PramB As Integer
     Dim Period As Integer
     Dim ToDate As Range
     Dim StartMth As Range
     Dim EndMth As Range
     Dim ContractExp As Long
     Dim Loading As String
     Dim Advance As Single
     Dim Retention As Single
     Dim Project As Range
     Dim StartCol As Long
     Dim FinishCol As Long
     Dim MinDate As Long
     Dim GraphStartCol As Long
     Dim MaxDate As Long
     Dim GraphFinishCol As Long
     Dim AllStartDates As Range
     Dim AllFinishDates As Range
     Dim GraphStartColLetters As String
     Dim GraphFinishColLetters As String
     Dim Data As Range
     Dim intCounter As Integer
     
     
     
     
     
Application.ScreenUpdating = False
'Application.Calculation = xlCalculationManual
Sheets("Cashflow").Select
    
 'Clear Previous
    Range("Data").Select
    Selection.ClearContents
    Selection.Interior.Pattern = xlNone
    Selection.Interior.TintAndShade = 0
    Selection.Style = "Comma"
    
    Range("H28:CM28").Select
    Selection.ClearContents
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
     
    Range("A2").Select
     
     
intCounter = 0
SecondLoop:
     
  ' Set Do loop to stop when an empty cell is reached.
         Do Until IsEmpty(ActiveCell)
     
         Budget = -0.001
         Duration = 0
         StartDate = 0
         FinishDate = 0
         Advance = -1
         Retention = -1
         Loading = vbNullString
       
                  
            'Get Start Date
                Cells(ActiveCell.Row, 1).Select
                Do
                     If Cells(1, ActiveCell.Column) = "Start Date" Then StartDate = ActiveCell.Value
                    ActiveCell.Offset(0, 1).Select
                Loop Until StartDate > 0
                                   
            ' Get Start Column
                    StartCol = Application.Match(CLng(StartDate), Range("1:1"), 1)
            'MsgBox (StartCol)
                                              
                    
            'Get Finish Date
                Cells(ActiveCell.Row, 1).Select
                Do
                     If Cells(1, ActiveCell.Column) = "Finish Date" Then FinishDate = ActiveCell.Value
                     ActiveCell.Offset(0, 1).Select
                 Loop Until FinishDate > 0
                 
            ' Get Finish Column
            FinishCol = Application.Match(CLng(FinishDate), Range("1:1"), 1)
            'MsgBox (FinishCol)
                 
                
            'Calculate Project Duration
            Duration = DateDiff("M", StartDate, FinishDate) + 1
            
                    
            'Get Budget
                Cells(ActiveCell.Row, 1).Select
                Do
                     If Cells(1, ActiveCell.Column) = "Budget" Then Budget = ActiveCell.Value
                     ActiveCell.Offset(0, 1).Select
                 Loop Until Budget > -0.001
                 
                 
                                     
                 
            'Get Advance
                Cells(ActiveCell.Row, 1).Select
                Do
                     If Cells(1, ActiveCell.Column) = "Advance Payment" Then Advance = ActiveCell.Value
                     ActiveCell.Offset(0, 1).Select
                 Loop Until Advance > -1
                                            
                                            
            'Get Retention
                Cells(ActiveCell.Row, 1).Select
                Do
                     If Cells(1, ActiveCell.Column) = "Retention" Then Retention = ActiveCell.Value
                     ActiveCell.Offset(0, 1).Select
                 Loop Until Retention > -1
                                            
                                                                                                            
                ContractExp = Budget - (Budget * Advance) - (Budget * Retention)
           
           ' MsgBox (ContractExp)
            
                 
            'Get Loading
                Cells(ActiveCell.Row, 1).Select
                Do
                     If Cells(1, ActiveCell.Column) = "Loading" Then Loading = ActiveCell.Value
                     ActiveCell.Offset(0, 1).Select
                 Loop Until Not Loading = ""
               
            
            If Loading = "Front" Then
                PramA = 1
                PramB = 0
                                 
            ElseIf Loading = "Back" Then
                PramA = 0
                PramB = 0
                
            Else
                PramA = 0
                PramB = 1
                
            
            End If
               'MsgBox (PramA & PramB)
                             
            
            'Fill Cashflow
             'Start at Start Date
             
             Cells(ActiveCell.Row, StartCol).Select
             ActiveWorkbook.Names.Add Name:="StartMth", RefersToR1C1:=ActiveCell
                 
                                        
                If Loading = "Flat" Then
                    Period = 0
                    
                    Do
                    
                    Period = Period + 1
                    
                    ActiveCell.Value = (ContractExp / Duration)
                
                     ActiveCell.Offset(0, 1).Select
                     Loop Until Period = Duration
                    
                      ActiveCell.Offset(0, -1).Select
                      
                      ActiveWorkbook.Names.Add Name:="EndMth", RefersToR1C1:=ActiveCell
            
                Else
                
                                            
                    Period = 0
                    Duration = Duration - 1
                    
                    ActiveCell.Offset(0, 1).Select
                             
                    Do
                    
                    Period = Period + 1
                    
                    ActiveCell.Value = ((10 * (Period / Duration) ^ 2 * (1 - (Period / Duration)) ^ 2 _
                    * (PramA + PramB * (Period / Duration)) + (Period / Duration) ^ 4 _
                    * (5 - 4 * (Period / Duration))) * ContractExp) - WorksheetFunction.Sum(Range("StartMth", ActiveCell.Offset(0, -1)))
                
                     ActiveCell.Offset(0, 1).Select
                     Loop Until Period = Duration
                            
                      ActiveCell.Offset(0, -1).Select
                      
                      ActiveWorkbook.Names.Add Name:="EndMth", RefersToR1C1:=ActiveCell
                End If
            
              'Pay Advance Payment
                If Advance > 0 Then
                    Application.GoTo Reference:="StartMth"
                    ActiveCell.Value = ActiveCell.Value + (Budget * Advance)
                End If
              
              'Release Retention
                If Retention > 0 Then
            
                    'Release 1st Half Retention
                    Application.GoTo Reference:="EndMth"
                    ActiveCell.Value = ActiveCell.Value + (Budget * (Retention / 2))
            
                     
                    'Release 2nd half Retention
                    ActiveCell.Offset(0, 12).Select
                    ActiveCell.Value = Budget * (Retention / 2)
                     
                End If
                 
      
                ' Shade Cells
                Range("StartMth", "EndMth").Select
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 65535
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
      
        Cells(ActiveCell.Row, 1).Select
        ActiveCell.Offset(1, 0).Select
        If intCounter = 1 Then
            GoTo DoneWithSecondLoop:
        
        End If
        Loop
         
Application.GoTo Reference:="CumSC"
 
intCounter = intCounter + 1
 
    If intCounter = 2 Then
        GoTo DoneWithSecondLoop:
    Else
        GoTo SecondLoop:
    End If
    
DoneWithSecondLoop:
         
' Set up Graph
    ' Get Earliest Date
    MinDate = Application.WorksheetFunction.Min(Range("AllStartDates"))
    ' Get Graph Start Column
    GraphStartCol = (Application.Match(CLng(MinDate), Range("1:1"), 1)) - 2
    GraphStartColLetters = Split(Cells(1, GraphStartCol).Address, "$")(1)
    ' Get Latest Date
    MaxDate = Application.WorksheetFunction.Max(Range("AllFinishDates"))
    ' Get Graph Finish Column
    GraphFinishCol = (Application.Match(CLng(MaxDate), Range("1:1"), 1)) + 14
    GraphFinishColLetters = Split(Cells(1, GraphFinishCol).Address, "$")(1)
    'MsgBox (GraphStartColLetters & " " & GraphFinishColLetters)
' Set Graph Data
    Sheets("Chart").Select
    ActiveChart.SetSourceData Source:=Sheets("Cashflow").Range("A1," & GraphStartColLetters & _
    "1:" & GraphFinishColLetters & "1,A25:A26," & GraphStartColLetters & "25:" & GraphFinishColLetters & "26")
    
    Sheets("SC Overlay Chart").Select
    ActiveChart.SetSourceData Source:=Sheets("Cashflow").Range("A1," & GraphStartColLetters & _
    "1:" & GraphFinishColLetters & "1,A25:A26," & GraphStartColLetters & "25:" & GraphFinishColLetters & "26,A29," _
    & GraphStartColLetters & "29:" & GraphFinishColLetters & "29")
    
    Sheets("SC Only Chart").Select
    ActiveChart.SetSourceData Source:=Sheets("Cashflow").Range("A1," & GraphStartColLetters & _
    "1:" & GraphFinishColLetters & "1,A26," & GraphStartColLetters & "26:" & GraphFinishColLetters & "26,A29," & GraphStartColLetters & "29:" & GraphFinishColLetters & "29")
   
   
   'Application.Calculation = xlCalculationAutomatic
       
Sheets("Cashflow").Select
   
   End Sub

Not sure how to send you the actual file, but I can do that.

I am currently working on a Version 2 of this that would allow me to cater for Budget, Actual and Forecast graphs.

Regards

taltyr