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