Sub Create_ExportSheet()
'
' www.excelschooling.com Phone +919840517999
'
'If wsTest Is Nothing Then
' Worksheets.Add(After:=Sheets(Sheets.Count)).Name = strSheetName
'End If
'Check Sheet="Costing Delivery" is thier if not it will exit.
'On Error Resume Next
'Dim wsTest2 As Worksheet
'Const strSheetName As String = "Costing Delivery"
'Set wsTest2 = Nothing
'If wsTest2 Is Nothing Then
'Exit Sub
'End If
'On Error Resume Next
'On Error GoTo 0
'==========================================
On Error Resume Next
'Check Sheet ("Export") is their, if not sheet will be added
Dim wsTest As Worksheet
Const sSheetName As String = "Export"
Set wsTest = Nothing
On Error Resume Next
Set wsTest = ActiveWorkbook.Worksheets(sSheetName)
On Error GoTo 0
If wsTest Is Nothing Then
Worksheets.Add(After:=Sheets(Sheets.Count)).Name = sSheetName
End If
'=========================================
'Add Header
Worksheets("Export").Select
If Range("A2") = "Name" Then
Range("a2").Select
Else
Range("A3").Select
ActiveCell.FormulaR1C1 = "Name"
Range("B3").Select
ActiveCell.FormulaR1C1 = "Customer"
Range("C3").Select
ActiveCell.FormulaR1C1 = "Project"
Range("D3").Select
ActiveCell.FormulaR1C1 = "Cost Centre"
Range("E3").Select
ActiveCell.FormulaR1C1 = "Revenue"
Range("F3").Select
ActiveCell.FormulaR1C1 = "Total Cost"
Range("G3").Select
ActiveCell.FormulaR1C1 = "GM (Value)"
Range("H3").Select
ActiveCell.FormulaR1C1 = "GM in %"
Range("I3").Select
ActiveCell.FormulaR1C1 = "Revenue"
Range("J3").Select
ActiveCell.FormulaR1C1 = "Total Cost"
Range("K3").Select
ActiveCell.FormulaR1C1 = "GM (Value)"
Range("L3").Select
ActiveCell.FormulaR1C1 = "GM in %"
Range("M3").Select
ActiveCell.FormulaR1C1 = "Revenue"
Range("N3").Select
ActiveCell.FormulaR1C1 = "Total Cost"
Range("O3").Select
ActiveCell.FormulaR1C1 = "GM (Value)"
Range("P3").Select
ActiveCell.FormulaR1C1 = "GM in %"
Range("Q3").Select
ActiveCell.FormulaR1C1 = "AR"
Range("R3").Select
ActiveCell.FormulaR1C1 = "UBR"
Range("S3").Select
ActiveCell.FormulaR1C1 = "Total Investment"
Range("M2").Select
ActiveCell.FormulaR1C1 = "LE Balance Year"
Range("I2").Select
ActiveCell.FormulaR1C1 = "For the month"
Range("E2").Select
ActiveCell.FormulaR1C1 = "YTD Margin"
Range("E2:H2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("I2:L2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("M2:P2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("S2:S3").Select
Range("S3").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Columns("S:S").EntireColumn.AutoFit
Range("R2:R3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("Q2:Q3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("D2:D3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("C2:C3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("B2:B3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A2:A3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A2:S3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 192
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.Font.Bold = True
Range("A1").Select
End If
'=========================================
On Error Resume Next
Dim path As String
Dim RPT As String
Dim ws As Worksheet
Set ws = Worksheets("Costing Delivery")
Worksheets("Export").Select
path = ActiveWorkbook.path
RPT = Application.WorksheetFunction.Rept(" ", 100)
'Trim(Right(Replace(path, "\", Rept(" ", "100"), 100)))
Range("A4").Value = Trim(Right(Replace(path, "\", RPT), 100))
Range("B4").Value = ws.Range("b4").Value
Range("c4").Value = ws.Range("b1").Value
Range("d4").Value = ws.Range("b2").Value
'=================================================================
'fill cost and revenue
Dim mydate As Date
Dim DateRng As Variant
Dim myCost As Variant
Dim myRev As Variant
Dim MTDCost As Double, MTDRev As Double
Dim LEPro_Cost As Double, LePro_Rev As Double
Worksheets("Costing Delivery").Select
'Dim myrev As Range
Dim LMonth As Date
Dim FindcostRow As Range
Dim FindRevenueRow As Range
'Dim lastcolumn As Range
LMonth = Date - Day(Date) + 1
mydate = LMonth
With ws
Set FindcostRow = .Range("A:A").Find(What:="Total Cost", LookIn:=xlValues)
Set FindRevenueRow = .Range("A:A").Find(What:="Revenue", LookIn:=xlValues)
End With
Dim CostRowNumber As Long
Dim RevenueRowNumber As Long
CostRowNumber = FindcostRow.Row
RevenueRowNumber = FindRevenueRow.Row
'get lastcolumn number from row number 17
'lastcolumn = ws.Cells(17, Columns.Count).End(xlToLeft).Column
'Debug.Print lastcolumn
DateRng = ws.Range("E17:" & Cells(17, Columns.Count).End(xlToLeft).Address).Value
'myCost = ws.Range("E" & CostRowNumber & ":" & Cells(CostRowNumber, Columns.Count).End(xlToLeft).Address).Value
myCost = ws.Range("E" & CostRowNumber & ":" & Cells(CostRowNumber, ws.Cells(17, Columns.Count).End(xlToLeft).Column).Address).Value
myRev = ws.Range("E" & RevenueRowNumber & ":" & Cells(RevenueRowNumber, ws.Cells(17, Columns.Count).End(xlToLeft).Column).Address).Value
'myRev = ws.Range("E" & RevenueRowNumber & ":" & Cells(RevenueRowNumber, Columns.Count).End(xlToLeft).Address).Value
Dim i As Integer
Dim j As Integer
'Find MTD
For i = 1 To UBound(DateRng, 2)
If DateRng(1, i) = mydate Then
MTDCost = myCost(1, i)
MTDRev = myRev(1, i)
j = i + 1
End If
Next i
'Find Le Pro
i = j
Do
LEPro_Cost = LEPro_Cost + myCost(1, i)
LePro_Rev = LePro_Rev + myRev(1, i)
'Debug.Print i, Month(DateRng(1, i)), LEPro_Cost, LePro_Rev
i = i + 1
Loop Until Month(DateRng(1, i)) = 4
Debug.Print "MTD Cost "; MTDCost
Debug.Print "MTD Revenue "; MTDRev
Debug.Print "Le Pro Cost "; LEPro_Cost
Debug.Print "Le Pro Revenue "; LePro_Rev
'===================================================
Worksheets("Export").Select
Range("i4").Value = MTDRev
Range("j4").Value = MTDCost
Range("K4").Value = MTDRev - MTDCost
Range("L4").Value = Range("k4") / MTDRev
Range("M4").Value = LePro_Rev
Range("N4").Value = LEPro_Cost
Range("O4").Value = LePro_Rev - LEPro_Cost
Range("P4").Value = Range("O4") / LePro_Rev
'change cell format
Range("i4:k4,m4:o4").Select
Selection.NumberFormat = "0.00_);[Red](0.00)"
Range("L4,p4").Select
Selection.NumberFormat = "0.00%"
Range("a1").Select
End Sub