NORMDIST Function

taltyr

New Member
Joined
Jul 20, 2011
Messages
31
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;

Code:
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
 

Some videos you may like

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

Watch MrExcel Video

Forum statistics

Threads
1,099,517
Messages
5,469,101
Members
406,636
Latest member
DhyanaDubai

This Week's Hot Topics

Top