Macro re-written...thoughts?

R

rdw72777

Well-known Member
Joined
Apr 5, 2005
Messages
723
Since you all helped write it, I thought I'd post it here for a final review. it works (most important) but I think its also pretty easy to understand for when i hand it off to a new employee in a month or 2.

As always any suggestions are appreiated, and i apologize for posting code this long but I like to keep macros whole wherever possible isntead of portioning them out into smaller subs...

Thanks

Code: 
Sub ProcessData()
    
Dim InputDataRows As Long
Dim OutputDataRows As Long
Dim Input_Tab_DataColumns As Long, DS_Tab_DataColumns As Long
Dim Input_UniqueID_Col As Integer, Input_PM_Col As Integer, Input_Act_Code_Col As Integer, Input_Sterling_Col As Integer, Input_Project_Col As Integer, Input_Function_Col As Integer, Input_WPDesc_Col As Integer, Input_WPC_Col As Integer, Input_ActStartDate_Col As Integer, Input_ActEndDate_Col As Integer, Input_ActStatus_Col As Integer, Input_Cost_Col As Integer, Input_CurrEst_Col As Integer, Input_EstNotes_Col As Integer, Input_YTDCurrEst_Col As Integer, Input_YTDActuals_Col As Integer, Input_Variance_Col As Integer, Input_VarianceComments_Col As Integer, Check As Integer
Dim DS_UniqueID_col As Integer, DS_PM_Col As Integer, DS_Act_Code_Col As Integer, DS_Sterling_Col As Integer, DS_Project_Col As Integer, DS_Function_Col As Integer, DS_WPDesc_Col As Integer, DS_WPC_col As Integer, DS_ActStartDate_Col As Integer, DS_ActEndDate_Col As Integer, DS_ActStatus_Col As Integer, DS_Cost_Col As Integer, DS_CurrEst_Col As Integer, DS_CurrDirEst_Col As Integer, DS_EstNotes_Col As Integer, DS_Empty_Col As Integer, DS_YTDCurrEst_Col As Integer, DS_YTDActuals_Col As Integer, DS_Variance_Col As Integer, DS_VarianceComments_Col As Integer
Dim PCDWP_WPC_col As Integer, PCDWP_STDEst_Col As Integer
Dim ColTitle As String
Dim DataPresent As Boolean
Dim myDSHeaderRow As Long, myDSStartRow As Long, myDSDataSourceRow As Long
Dim myInputHeaderRow As Long, myInputStartRow As Long
Dim myPCDWPHeaderRow As Long
Dim myArea As Variant
Dim rngCell As Variant
Dim TANameListCount As Long, myTANameListCol As Long
Dim i As Long
Dim myTAAbbrv1 As Variant, myTAAbbrv2 As Variant
Dim myrow As Long
Dim InputSheet As Worksheet, DSSheet As Worksheet, RateSheet As Worksheet
Dim wkb As Workbook


'Set workbook sheet names, will be used throughout code
Set wkb = ThisWorkbook
Set InputSheet = wkb.Worksheets("Input")
Set DSSheet = wkb.Worksheets("Daily Schedule")
Set RateSheet = wkb.Worksheets("Rates")
Set PackageSheet = wkb.Worksheets("Packages")


DataPresent = False

    'Clear old data from report (assumes there will never be more than 30,000 rows on prior report
    'Won't be necessary in teh ftuure when template is used each month
    DSSheet.Rows("6:30000").Delete shift:=xlUp
    
    'Clear old formatting from report (except formatted column headers)
    DSSheet.Cells.FormatConditions.Delete

    'Unfilter "Input" tab and determine last data row
    With InputSheet
        .Range("A:EZ").AutoFilter Field:=3, Criteria1:="O"
        .ShowAllData
        InputDataRows = .Range("c" & Rows.Count).End(xlUp).Row
    End With

    'Determine various "Input" tab cells/rows using named ranges
    With InputSheet
        myInputHeaderRow = .Range("myInputHeaderRow").Row
        myInputStartRow = .Range("myInputStartRow").Row
        Input_Tab_DataColumns = .Cells.Find(What:="*", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
    End With
    
    'Remove all hard stops (Alt+Enter) characters in header rows on input tab
    'This is done for easier using of column header names in this macro
    For i = 1 To Input_Tab_DataColumns
        InputSheet.Cells(myInputHeaderRow, i) = WorksheetFunction.Clean(InputSheet.Cells(myInputHeaderRow, i))
    Next i
    
    'identify the columns on the "Input" tab to be copied down / sorted on
    With InputSheet.Rows(myInputHeaderRow)
    
        Input_UniqueID_Col = .Find(What:="Unique ID", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        Input_PM_Col = .Find(What:="PM", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        Input_Act_Code_Col = .Find(What:="Activity Code", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        Input_Sterling_Col = .Find(What:="Silver Code", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        Input_Project_Col = .Find(What:="Project", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        Input_Function_Col = .Find(What:="Function", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        Input_WPDesc_Col = .Find(What:="Package Description", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        Input_WPC_Col = .Find(What:="WPC", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        Input_ActStartDate_Col = .Find(What:="Activity Start Date", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        Input_ActEndDate_Col = .Find(What:="Activity End Date", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        Input_ActStatus_Col = .Find(What:="Activity Status", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        Input_CurrEst_Col = .Find(What:="CURRENT EST", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        Input_EstNotes_Col = .Find(What:="Comments", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        Input_YTDCurrEst_Col = .Find(What:="YTDCUR EST", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        Input_YTDActuals_Col = .Find(What:="YTDACT", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        Input_VarianceComments_Col = .Find(What:="Variance Comments", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        Input_StdDur_Col = .Find(What:="STD Duration", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        Input_StdEst_Col = .Find(What:="STD EST", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        Check = .Find(What:="Owner", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
    
    End With
   
    'Determine various "Daily Schedule" tab cells/rows using named ranges
    With DSSheet
    
        myDSHeaderRow = .Range("myDSHeaderRow").Row
        myDSStartRow = .Range("myDSStartRow").Row
        myDSDataSourceRow = .Range("myDSDataSourceRow").Row
        myTherapeuticArea = .Range("myTherapeuticArea").Value
    
    End With
    
    'find how many columns of data are in the Input tab
    DS_Tab_DataColumns = DSSheet.Cells.Find(What:="*", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
    
    'identify the columns on the "Daily Schedule" tab to be pasted into
    With DSSheet.Rows(myDSHeaderRow)
    
        DS_UniqueID_col = .Find(What:="Unique ID", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        DS_PM_Col = .Find(What:="PM", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        DS_Act_Code_Col = .Find(What:="Activity Code", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        DS_Sterling_Col = .Find(What:="Silver Code", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        DS_Project_Col = .Find(What:="Project", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        DS_Function_Col = .Find(What:="Function", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        DS_WPDesc_Col = .Find(What:="Package Description", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        DS_WPC_col = .Find(What:="WPC", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        DS_ActStartDate_Col = .Find(What:="Activity Start Date", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        DS_ActEndDate_Col = .Find(What:="Activity End Date", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        DS_ActStatus_Col = .Find(What:="Activity Status", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        DS_Cost_Col = .Find(What:="Estimated Cost", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        DS_CurrEst_Col = .Find(What:="Current Estimate", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        DS_CurrDirEst_Col = .Find(What:="Current Estimate Direct", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        DS_EstNotes_Col = .Find(What:="Estimating Notes / Comments", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        DS_Empty_Col = .Find(What:=".", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        DS_YTDCurrEst_Col = .Find(What:="YTD CUR EST)", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        DS_YTDActuals_Col = .Find(What:="YTD ACT ", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        DS_Variance_Col = .Find(What:="Variance Fav / (UnFav)", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        DS_VarianceComments_Col = .Find(What:="Explanation of Variance", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
     
    End With
    
    'Set the column letter for select "Daily Schedule" columns (enables usage in formulas in later steps
    DS_UniqueID_Col_Letter = ColumnLetter(DS_UniqueID_col)
    DS_ActStatus_Col_Letter = ColumnLetter(DS_ActStatus_Col)
    DS_WPC_Col_Letter = ColumnLetter(DS_WPC_col)
    DS_YTDActuals_Col_Letter = ColumnLetter(DS_YTDActuals_Col)
    DS_Variance_Col_Letter = ColumnLetter(DS_Variance_Col)
    DS_VarianceComments_Col_Letter = ColumnLetter(DS_VarianceComments_Col)
    
    'find how many columns of data are in the "packages" tab
    With PackageSheet
    
        PCDWP_Tab_DataColumns = .Cells.Find(What:="*", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        PCDWPDataRows = .Range("a" & Rows.Count).End(xlUp).Row
        myPCDWPHeaderRow = .Range("myPCDWPHeaderRow").Row
       
    End With
    
    'identify the columns on the "Daily Schedule" tab to be pasted into
    With PackageSheet
    
        PCDWP_WPC_col = .Rows(myPCDWPHeaderRow).Find(What:="iPlan WP Code", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        PCDWP_STDEst_Col = .Rows(myPCDWPHeaderRow).Find(What:="STD EST Total FTE (in person months)", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
            
    End With
    
    'Set the column letter for select "Daily Schedule" columns (enables usage in formulas in later steps
    PCDWP_WPC_col_Letter = ColumnLetter(PCDWP_WPC_col)
    PCDWP_STDEst_Col_Letter = ColumnLetter(PCDWP_STDEst_Col)
            
    'check to see if there is any data for the business unit in question
    InputSheet.Select
    InputSheet.Range(Cells(4, Check), Cells(InputDataRows, Check)).Copy
    Sheets("Activity Status Codes").Columns("D:D").PasteSpecial Paste:=xlPasteValues
    Sheets("Activity Status Codes").Range("D:D").RemoveDuplicates Columns:=1, Header:=xlNo
    
    'Determine various "FACT Rates" tab cells/rows using named ranges
    myTANameListCol = RateSheet.Range("TA_Name_List").Column
    
    'Determine number of TA's names on the "FACT Rates" tab for use in the For-Next loop below
    TANameListCount = RateSheet.Columns(myTANameListCol).Find(What:="*", SearchDirection:=xlPrevious, LookAt:=xlWhole, SearchOrder:=xlByColumns).Row
    
    'Remove pink formatting from Comments/Variance Comments columns by pasting formats from
    'Activity Status Column to the Comments/Variance Comments columns
    With InputSheet
    
        .Select
        .Range(Cells(myInputStartRow, Input_ActStatus_Col), Cells(InputDataRows, Input_ActStatus_Col)).Copy
        .Cells(myInputStartRow, Input_EstNotes_Col).PasteSpecial Paste:=xlPasteFormats
        .Cells(myInputStartRow, Input_VarianceComments_Col).PasteSpecial Paste:=xlPasteFormats
        .Columns(Input_EstNotes_Col).WrapText = True
        .Columns(Input_VarianceComments_Col).WrapText = True
    
    End With
    
    'Remove pink formatting from STD Estimate/STD Duration columns by pasting formats from
    'Activity Status Column to the STD Estimate/STD Duration columns
    With InputSheet
    
        .Range(Cells(myInputStartRow, Input_CurrEst_Col), Cells(InputDataRows, Input_CurrEst_Col)).Copy
        .Cells(myInputStartRow, Input_StdDur_Col).PasteSpecial Paste:=xlPasteFormats
        .Cells(myInputStartRow, Input_StdEst_Col).PasteSpecial Paste:=xlPasteFormats
            
    End With
    
    'filter on only the selected area
    For i = 2 To TANameListCount
        
        counter = 0
    
        myTherapeuticArea = RateSheet.Cells(i, myTANameListCol).Value
        myTAAbbrv1 = RateSheet.Cells(i, myTANameListCol + 1).Value
        myTAAbbrv2 = RateSheet.Cells(i, myTANameListCol + 2).Value
    
        If DSSheet.Range("Area") = myArea Then
            InputSheet.Range("A:EZ").AutoFilter Field:=Check, Criteria1:="=" & myTAAbbrv1, Operator:=xlOr, Criteria2:="=" & myTAAbbrv2
            Set rngCell = InputSheet.Cells(myInputHeaderRow, Check)
            Do Until rngCell.Value = "" Or DataPresent
                DataPresent = (UCase(rngCell.Value) = UCase(myTAAbbrv1)) Or (UCase(rngCell.Value) = UCase(myTAAbbrv2))
                Set rngCell = rngCell.Offset(1)
            Loop
            counter = counter + 1
        End If
        
               
        If DSSheet.Range("myArea") = myArea Then
            i = TANameListCount
        End If
    
    Next i
    
    If counter = 0 Then
        MsgBox "TA on the Daily Schedule tab is not recognized."
        End
    End If

    If DataPresent = False Then
        MsgBox "There is no data on the input tab associated with that TA."
        End
    End If
    
    
    'For some reason macro bombs if you don't select "Input" tab here
    InputSheet.Select
    
    'Copy Paste data from "Input" tab to "Daily Schedule" tab
    'Must paste values first and then paste formats
    'Unique ID
    InputSheet.Range(Cells(myInputStartRow, Input_UniqueID_Col), Cells(InputDataRows, Input_UniqueID_Col)).Copy
    DSSheet.Cells(myDSStartRow, DS_UniqueID_col).PasteSpecial Paste:=xlPasteValues
    DSSheet.Cells(myDSStartRow, DS_UniqueID_col).PasteSpecial Paste:=xlPasteFormats
    'Project Manager (PM)
    InputSheet.Range(Cells(myInputStartRow, Input_PM_Col), Cells(InputDataRows, Input_PM_Col)).Copy
    DSSheet.Cells(myDSStartRow, DS_PM_Col).PasteSpecial Paste:=xlPasteValues
    DSSheet.Cells(myDSStartRow, DS_PM_Col).PasteSpecial Paste:=xlPasteFormats
    'Activity Code
    InputSheet.Range(Cells(myInputStartRow, Input_Act_Code_Col), Cells(InputDataRows, Input_Act_Code_Col)).Copy
    DSSheet.Cells(myDSStartRow, DS_Act_Code_Col).PasteSpecial Paste:=xlPasteValues
    DSSheet.Cells(myDSStartRow, DS_Act_Code_Col).PasteSpecial Paste:=xlPasteFormats
    'Sterling Code
    InputSheet.Range(Cells(myInputStartRow, Input_Sterling_Col), Cells(InputDataRows, Input_Sterling_Col)).Copy
    DSSheet.Cells(myDSStartRow, DS_Sterling_Col).PasteSpecial Paste:=xlPasteValues
    DSSheet.Cells(myDSStartRow, DS_Sterling_Col).PasteSpecial Paste:=xlPasteFormats
    'Project ID
    InputSheet.Range(Cells(myInputStartRow, Input_Project_Col), Cells(InputDataRows, Input_Project_Col)).Copy
    DSSheet.Cells(myDSStartRow, DS_Project_Col).PasteSpecial Paste:=xlPasteValues
    DSSheet.Cells(myDSStartRow, DS_Project_Col).PasteSpecial Paste:=xlPasteFormats
    'Function
    InputSheet.Range(Cells(myInputStartRow, Input_Function_Col), Cells(InputDataRows, Input_Function_Col)).Copy
    DSSheet.Cells(myDSStartRow, DS_Function_Col).PasteSpecial Paste:=xlPasteValues
    DSSheet.Cells(myDSStartRow, DS_Function_Col).PasteSpecial Paste:=xlPasteFormats
    'Work Package Description
    InputSheet.Range(Cells(myInputStartRow, Input_WPDesc_Col), Cells(InputDataRows, Input_WPDesc_Col)).Copy
    DSSheet.Cells(myDSStartRow, DS_WPDesc_Col).PasteSpecial Paste:=xlPasteValues
    DSSheet.Cells(myDSStartRow, DS_WPDesc_Col).PasteSpecial Paste:=xlPasteFormats
    'Work Package Code
    InputSheet.Range(Cells(myInputStartRow, Input_WPC_Col), Cells(InputDataRows, Input_WPC_Col)).Copy
    DSSheet.Cells(myDSStartRow, DS_WPC_col).PasteSpecial Paste:=xlPasteValues
    DSSheet.Cells(myDSStartRow, DS_WPC_col).PasteSpecial Paste:=xlPasteFormats
    'Activity Start Date
    InputSheet.Range(Cells(myInputStartRow, Input_ActStartDate_Col), Cells(InputDataRows, Input_ActStartDate_Col)).Copy
    DSSheet.Cells(myDSStartRow, DS_ActStartDate_Col).PasteSpecial Paste:=xlPasteValues
    DSSheet.Cells(myDSStartRow, DS_ActStartDate_Col).PasteSpecial Paste:=xlPasteFormats
    'Activity End Date
    InputSheet.Range(Cells(myInputStartRow, Input_ActEndDate_Col), Cells(InputDataRows, Input_ActEndDate_Col)).Copy
    DSSheet.Cells(myDSStartRow, DS_ActEndDate_Col).PasteSpecial Paste:=xlPasteValues
    DSSheet.Cells(myDSStartRow, DS_ActEndDate_Col).PasteSpecial Paste:=xlPasteFormats
    'Activity Status
    InputSheet.Range(Cells(myInputStartRow, Input_ActStatus_Col), Cells(InputDataRows, Input_ActStatus_Col)).Copy
    DSSheet.Cells(myDSStartRow, DS_ActStatus_Col).PasteSpecial Paste:=xlPasteValues
    DSSheet.Cells(myDSStartRow, DS_ActStatus_Col).PasteSpecial Paste:=xlPasteFormats
    'Current Estimate Total FTE
    InputSheet.Range(Cells(myInputStartRow, Input_CurrEst_Col), Cells(InputDataRows, Input_CurrEst_Col)).Copy
    DSSheet.Cells(myDSStartRow, DS_CurrEst_Col).PasteSpecial Paste:=xlPasteValues
    DSSheet.Cells(myDSStartRow, DS_CurrEst_Col).PasteSpecial Paste:=xlPasteFormats
    'Estimate Comments/Notes
    InputSheet.Range(Cells(myInputStartRow, Input_EstNotes_Col), Cells(InputDataRows, Input_EstNotes_Col)).Copy
    DSSheet.Cells(myDSStartRow, DS_EstNotes_Col).PasteSpecial Paste:=xlPasteValues
    DSSheet.Cells(myDSStartRow, DS_EstNotes_Col).PasteSpecial Paste:=xlPasteFormats
    'YTD Curr Est Direct FTE
    InputSheet.Range(Cells(myInputStartRow, Input_YTDCurrEst_Col), Cells(InputDataRows, Input_YTDCurrEst_Col)).Copy
    DSSheet.Cells(myDSStartRow, DS_YTDCurrEst_Col).PasteSpecial Paste:=xlPasteValues
    DSSheet.Cells(myDSStartRow, DS_YTDCurrEst_Col).PasteSpecial Paste:=xlPasteFormats
    'YTD Actual FTE
    InputSheet.Range(Cells(myInputStartRow, Input_YTDActuals_Col), Cells(InputDataRows, Input_YTDActuals_Col)).Copy
    DSSheet.Cells(myDSStartRow, DS_YTDActuals_Col).PasteSpecial Paste:=xlPasteValues
    DSSheet.Cells(myDSStartRow, DS_YTDActuals_Col).PasteSpecial Paste:=xlPasteFormats
    'Variance Comments
    InputSheet.Range(Cells(myInputStartRow, Input_VarianceComments_Col), Cells(InputDataRows, Input_VarianceComments_Col)).Copy
    DSSheet.Cells(myDSStartRow, DS_VarianceComments_Col).PasteSpecial Paste:=xlPasteValues
    DSSheet.Cells(myDSStartRow, DS_VarianceComments_Col).PasteSpecial Paste:=xlPasteFormats
    
    'Determine number of rows on "Daily Schedule" tab
    OutputDataRows = DSSheet.Range("A" & Rows.Count).End(xlUp).Row
    
    'copy down formulas on "Daily Schedule" tab
    With DSSheet
        'Select the sheet, for some reason macro bombs without this code
        .Select
        
        'Est Cost
        .Cells(myDSStartRow, DS_Cost_Col).Copy
        .Range(Cells(myDSStartRow, DS_Cost_Col), Cells(OutputDataRows, DS_Cost_Col)).PasteSpecial Paste:=xlPasteFormulas
        'Current Estimate
        .Cells(myDSStartRow, DS_CurrDirEst_Col).Copy
        .Range(Cells(myDSStartRow, DS_CurrDirEst_Col), Cells(OutputDataRows, DS_CurrDirEst_Col)).PasteSpecial Paste:=xlPasteFormulas
        'YTD Variance
        .Cells(myDSStartRow, DS_Variance_Col).Copy
        .Range(Cells(myDSStartRow, DS_Variance_Col), Cells(OutputDataRows, DS_Variance_Col)).PasteSpecial Paste:=xlPasteFormulas
        
    End With
    
    'format the spreadsheet
    With DSSheet
    
        'Paste formats down in various columns
        
        'Paste formats from Curr Est column to Est Cost, Curr Est and Curr Est (Direct) columns
        .Range(Cells(myDSStartRow, DS_CurrEst_Col), Cells(OutputDataRows, DS_CurrEst_Col)).Copy
        .Range(Cells(myDSStartRow, DS_Cost_Col), Cells(OutputDataRows, DS_CurrDirEst_Col)).PasteSpecial Paste:=xlPasteFormats
        'Paste formats from YTD actuals column to YTD Variance column
        .Range(Cells(myDSStartRow, DS_YTDActuals_Col), Cells(OutputDataRows, DS_YTDActuals_Col)).Copy
        .Range(Cells(myDSStartRow, DS_Variance_Col), Cells(OutputDataRows, DS_Variance_Col)).PasteSpecial Paste:=xlPasteFormats
        'Set number format for Estimated Cost column
        .Range(Cells(myDSStartRow, DS_Cost_Col), Cells(OutputDataRows, DS_Cost_Col)).NumberFormat = "_-[$£-809]* #,##0_-;-[$£-809]* #,##0_-;_-[$£-809]* ""-""??_-;_-@_-"
        'Set the Comments/Notes column to wrap text
        .Columns(DS_EstNotes_Col).WrapText = True
        .Range(Cells(myDSStartRow, DS_EstNotes_Col), Cells(OutputDataRows, DS_EstNotes_Col)).Copy
        'Paste formats down for "Explanation of Variance" column
        .Range(Cells(myDSStartRow, DS_VarianceComments_Col), Cells(OutputDataRows, DS_VarianceComments_Col)).PasteSpecial Paste:=xlPasteFormats
    
        'Set borders
        
        'Set borders on whole Daily Schedule
        With .Range(Cells(myDSHeaderRow, DS_UniqueID_col), Cells(OutputDataRows, DS_VarianceComments_Col))
             .Borders(xlEdgeBottom).Weight = xlThin
             .Borders(xlInsideHorizontal).Weight = xlThin
        End With
        
        'Remove borders for empty column
        With .Range(Cells(myDSHeaderRow, DS_Empty_Col), Cells(OutputDataRows, DS_Empty_Col))
             .Borders(xlEdgeBottom).LineStyle = xlNone
             .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
        'Set borders on left hand side of report (before Estimates) header on report)
        With .Range(Cells(myDSHeaderRow, DS_UniqueID_col), Cells(OutputDataRows, DS_ActStatus_Col))
             .Borders(xlEdgeLeft).Weight = xlMedium
             .Borders(xlEdgeTop).Weight = xlMedium
             .Borders(xlEdgeBottom).Weight = xlMedium
             .Borders(xlEdgeRight).Weight = xlMedium
        End With
        'Set borders on "Estimates" section of report
        With .Range(Cells(myDSHeaderRow, DS_Cost_Col), Cells(OutputDataRows, DS_EstNotes_Col))
             .Borders(xlEdgeLeft).Weight = xlMedium
             .Borders(xlEdgeTop).Weight = xlMedium
             .Borders(xlEdgeBottom).Weight = xlMedium
             .Borders(xlEdgeRight).Weight = xlMedium
        End With
        'Set borders for YTD reporting section of report
        With .Range(Cells(myDSHeaderRow, DS_YTDCurrEst_Col), Cells(OutputDataRows, DS_VarianceComments_Col))
             .Borders(xlEdgeLeft).Weight = xlMedium
             .Borders(xlEdgeTop).Weight = xlMedium
             .Borders(xlEdgeBottom).Weight = xlMedium
             .Borders(xlEdgeRight).Weight = xlMedium
        End With
    
    End With
    
    'Clear old conditional formatting from report
    DSSheet.Cells.FormatConditions.Delete
    
    
    'Add conditional formatting for Term/Cancelled
    With DSSheet.Range(Cells(myDSStartRow, 1), Cells(OutputDataRows, DS_VarianceComments_Col))
        
        .FormatConditions.Add Type:=xlExpression, Formula1:="=OR($" & DS_ActStatus_Col_Letter & _
            myDSStartRow & "=""Terminated"",$" & DS_ActStatus_Col_Letter & _
            myDSStartRow & "=""Cancelled"",$" & DS_ActStatus_Col_Letter & _
            myDSStartRow & "=""ET Issue"")"
        .FormatConditions(1).Font.Color = -16776961
        .FormatConditions(1).StopIfTrue = False
    
    End With
    
    'Add conditional formatting for threshhold variance
    'The =>3 and =<-3 formulas are due to threshhold variance of +/- 3 person months
    With DSSheet.Range(Cells(myDSStartRow, DS_VarianceComments_Col), Cells(OutputDataRows, DS_VarianceComments_Col))
        
        .FormatConditions.Add Type:=xlExpression, Formula1:="=OR($" & DS_Variance_Col_Letter & _
            myDSStartRow & ">3, $" & DS_Variance_Col_Letter & _
            myDSStartRow & "<-3)"
        .FormatConditions(2).Interior.Color = 65535
        .FormatConditions(1).StopIfTrue = False
    
    End With
    
    'Add conditional formatting for threshhold variance part 2 (???)
    'The >=3 and =<-3 formulas are due to threshhold variance of +/- 3 person months
    With DSSheet.Range(Cells(myDSStartRow, DS_Variance_Col), Cells(OutputDataRows, DS_Variance_Col))
  
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlNotBetween, Formula1:="=2.999", Formula2:="=-2.999"
        .FormatConditions(2).Interior.Color = 65535
        .FormatConditions(1).StopIfTrue = False
    
    End With
    
    'Insert data validation list for Activity Status Column
    With DSSheet.Range(Cells(myDSStartRow, DS_ActStatus_Col), Cells(OutputDataRows, DS_ActStatus_Col))
        .Validation.Delete
        .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="='Activity Status Codes'!A4:A10"
    End With
    
    'Set Fonts for all columns
    With DSSheet
        'Set font color to ????
        .Range(Cells(myDSStartRow, DS_ActStatus_Col), Cells(OutputDataRows, DS_ActStatus_Col)).Font.Color = -65536
        .Range(Cells(myDSStartRow, DS_CurrEst_Col), Cells(OutputDataRows, DS_CurrEst_Col)).Font.Color = -65536
        .Range(Cells(myDSStartRow, DS_EstNotes_Col), Cells(OutputDataRows, DS_EstNotes_Col)).Font.Color = -65536
        .Range(Cells(myDSStartRow, DS_VarianceComments_Col), Cells(OutputDataRows, DS_VarianceComments_Col)).Font.Color = -65536
        'Set various fonts
        .Range(Cells(myDSStartRow, DS_Cost_Col), Cells(OutputDataRows, DS_CurrEst_Col)).Font.Bold = True
        .Range(Cells(myDSStartRow, DS_YTDCurrEst_Col), Cells(OutputDataRows, DS_Variance_Col)).NumberFormat = "0.0_);[Red](0.0)"
        .Range(Cells(myDSStartRow, DS_UniqueID_col), Cells(OutputDataRows, DS_VarianceComments_Col)).Font.Name = "Calibri"
        .Range(Cells(myDSStartRow, DS_UniqueID_col), Cells(OutputDataRows, DS_VarianceComments_Col)).Font.Size = 12
        .Range(Cells(myDSStartRow, DS_UniqueID_col), Cells(OutputDataRows, DS_VarianceComments_Col)).AutoFilter Field:=11, Criteria1:=Array("Active", "Calc / Manual", "Unplanned", "Completed", "Planned", "="), Operator:=xlFilterValues
        'Set print area to area with data (currently columns A thru T and from row 5 to last row of data)
        .PageSetup.PrintArea = DS_UniqueID_Col_Letter & myDSHeaderRow & ":" & DS_VarianceComments_Col_Letter & OutputDataRows
    
    End With
       
    
    '1st IF statement = put formula in green row to change to standard if not unplanned
    '2nd IF statement = delete green/unplanned rows where YTD actuals round to less than 0.1
    '2nd IF statement commented out, does not work correctly with Child rows
    With DSSheet
        For myrow = OutputDataRows To myDSStartRow Step -1
            .Cells(myrow, DS_ActStatus_Col).Select
            If .Cells(myrow, DS_ActStatus_Col).Interior.Color = RGB(204, 255, 204) And ActiveCell.Value = "Unplanned" Then
                .Cells(myrow, DS_ActStatus_Col).Offset(0, 2).Value = "=IF(OR($" & DS_ActStatus_Col_Letter & myrow & "=""Unplanned"", $" _
                    & DS_ActStatus_Col_Letter & myrow & "=""Cancelled""),0," & _
                    "IF(OR($" & DS_ActStatus_Col_Letter & myrow & "=""Completed"", $" & _
                    DS_ActStatus_Col_Letter & myrow & "=""Terminated""), $" & DS_YTDActuals_Col_Letter & _
                    myrow & ", VLOOKUP($" & DS_WPC_Col_Letter & myrow & _
                    ",'PCD Work Packages'!$" & PCDWP_WPC_col_Letter & myPCDWPHeaderRow & ":$" & _
                    PCDWP_STDEst_Col_Letter & PCDWPDataRows & ", " & _
                    (PCDWP_STDEst_Col - PCDWP_WPC_col + 1) & " ,0)))"
            End If
            
            'Delete "ET Issue", "Cancelled" or "Terminated" rows
            If .Cells(myrow, DS_ActStatus_Col).Value = "ET Issue" Or _
                .Cells(myrow, DS_ActStatus_Col).Value = "Cancelled" Or _
                .Cells(myrow, DS_ActStatus_Col).Value = "Terminated" Then
                .Rows(myrow).Delete shift:=xlUp
            End If
            
            'Delete unplanned rows below .05 YTD actuals
            If .Cells(myrow, DS_ActStatus_Col).Interior.Color = RGB(204, 255, 204) And _
                .Cells(myrow, DS_ActStatus_Col).Value = "Unplanned" And _
                .Cells(myrow, DS_YTDActuals_Col) < 0.05 Then
                .Rows(myrow).Delete shift:=xlUp
            End If
        Next myrow
    End With
    
    'Turn off notifications (helps when deleting tabs to prevent pop-up confirming deletion)
    Application.DisplayAlerts = False
    
    'clear & hide "Input" tab (to keep file small)
    With InputSheet
        .Range("A:EZ").AutoFilter Field:=DS_Act_Code_Col, Criteria1:="O"
        .ShowAllData  'clear all filters
        .Rows(myInputStartRow & ":" & InputDataRows).Delete shift:=xlUp
        .Visible = False
    End With
    
    'Hide FACT Rates tab
    RateSheet.Visible = False
    
    'Delete instructions tab
    Sheets("Instructions").Delete
    Sheets("Input").Delete
    Sheets("Activity Status Codes").Range("D:D").Delete
    
    'Turn on notifications
    Application.DisplayAlerts = True
          
    'Bring back to main tab
    DSSheet.Select
    
    'Reset column header names to display properly
    'Also hide select columns on the "Daily Schedule" tab
    With DSSheet
    
        'Current Estimate (Total) FTE's (2 font formats in same cell)
        .Cells(myDSHeaderRow, DS_CurrEst_Col).Select
        .Cells(myDSHeaderRow, DS_CurrEst_Col) = "Current Effort" & Chr(10) & "Estimate" & Chr(10) & "Total FTE" & Chr(10) & "(in person months)"
            With ActiveCell
                With .Characters(Start:=1, Length:=33).Font
                    .Name = "Calibri"
                    .Size = 14
                    .Bold = True
                End With
            
                With .Characters(Start:=35, Length:=18).Font
                    .Name = "Calibri"
                    .Size = 10
                    .Bold = False
                End With
            End With
        
        'Current Estimate (Direct) FTE's (2 font formats in same cell)
        .Cells(myDSHeaderRow, DS_CurrDirEst_Col).Select
        .Cells(myDSHeaderRow, DS_CurrDirEst_Col) = "Current Effort" & Chr(10) & "Estimate" & Chr(10) & "Direct FTE" & Chr(10) & "(in person months)"
            With ActiveCell
                With .Characters(Start:=1, Length:=33).Font
                    .Name = "Calibri"
                    .Size = 14
                    .Bold = True
                End With
            
                With .Characters(Start:=36, Length:=18).Font
                    .Name = "Calibri"
                    .Size = 10
                    .Bold = False
                End With
            End With
            
        'YTD Current Estimate (Direct) FTE's (2 font formats in same cell)
        .Cells(myDSHeaderRow, DS_YTDCurrEst_Col).Select
        .Cells(myDSHeaderRow, DS_YTDCurrEst_Col) = "YTD CUR EST" & Chr(10) & "Direct FTEs" & Chr(10) & "(in person months)"
            With ActiveCell
                With .Characters(Start:=1, Length:=22).Font
                    .Name = "Calibri"
                    .Size = 14
                    .Bold = True
                End With
            
                With .Characters(Start:=24, Length:=18).Font
                    .Name = "Calibri"
                    .Size = 10
                    .Bold = False
                End With
            End With
            
        'YTD Actual FTE's (2 font formats in same cell)
        .Cells(myDSHeaderRow, DS_YTDActuals_Col).Select
        .Cells(myDSHeaderRow, DS_YTDActuals_Col) = "YTD ACT" & Chr(10) & "Direct FTEs" & Chr(10) & "(in person months)"
            With ActiveCell
                With .Characters(Start:=1, Length:=18).Font
                    .Name = "Calibri"
                    .Size = 14
                    .Bold = True
                End With
            
                With .Characters(Start:=20, Length:=18).Font
                    .Name = "Calibri"
                    .Size = 10
                    .Bold = False
                End With
            End With
            
        'Hide select columns
        Columns(DS_UniqueID_col).EntireColumn.Hidden = True
        Columns(DS_PM_Col).EntireColumn.Hidden = True
        Columns(DS_Act_Code_Col).EntireColumn.Hidden = True
        Columns(DS_Sterling_Col).EntireColumn.Hidden = True
        Columns(DS_WPC_col).EntireColumn.Hidden = True
        Columns(DS_CurrDirEst_Col).EntireColumn.Hidden = True
        
        .Range("e1").Select
       
    End With
    
End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
You must log in or register to reply here.

Similar threads

A
  • Solved
Procedure fails on some sheets only
Replies
2
Views
60
AlexanderBB
A
N
  • Question Question
AutoFilter Field Macro Returns a Header Row only
2
Replies
11
Views
210
MARK858
MARK858
R
  • Solved
Pass Worksheet to general Sub (or Function)
Replies
8
Views
180
MARK858
MARK858
S
  • Question Question
Find 1st blank row to fill in when there is an active filter
2
Replies
11
Views
249
Alex Blakenburg
A
W
  • Solved
Looking For Tips To Improve My VBA
Replies
8
Views
227
who am i
W

Forum statistics

Threads
1,224,583
Messages
6,179,673
Members
452,937
Latest member
Bhg1984

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top