• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

sum based on current month

trprasad78

Member
Hi all,

i have attached sample file,

i need macro for sum the value based on current month.

If current month is Jan 17 the out put should be

MTD TOTAL Cost = Jan 17 ("J30")
MTD Revenue = Jan 17 ("J31")

le Pro Total cost = Feb 17 to Mar 17 ("K30" to "L30")
le pro revenue = feb 17 to Mar 17 ("K31" to "L31")

if current month is Feb 17 then MTD = Feb17 & le pro = MAR17
if current month is mar 17 then MTD = MAR 17 & LE Pro = NIL

if current month is Apr 17 then MTD = APR 17 & LE PRO = May 17 to Mar 18

hope you got understand it has to calculate based on financial year.

MTD Revenue should be in output sheet =output!I4
MTD Total cost should be in output sheet =output!J4

LE Project Revenue should be in output sheet =output!M4
LE Project Total cost should be in output sheet =output!N4

Thank you in advance
 

Attachments

MTD Rev =SUMIFS(Sheet1!E30:AO30,Sheet1!E17:AO17,Sheet1!F38)
MTD Costs =SUMIFS(Sheet1!E31:AO31,Sheet1!E17:AO17,Sheet1!F38)

Does le Pro mean remainder of Financial Year ?

Is your Financial Year April 1 thru to March 31

Le pro total Rev:
=SUMIFS(Sheet1!E31:AO31,Sheet1!E17:AO17,">"&Sheet1!F39,Sheet1!E17:AO17,"<"&DATE(IF(MONTH(F39)>3,YEAR(F39)+1,YEAR(F39)),4,1))

Le pro total Cost:

=SUMIFS(Sheet1!E30:AO30,Sheet1!E17:AO17,">"&Sheet1!F39,Sheet1!E17:AO17,"<"&DATE(IF(MONTH(F39)>3,YEAR(F39)+1,YEAR(F39)),4,1))
 
Last edited:
MTD Rev =SUMIFS(Sheet1!E30:AO30,Sheet1!E17:AO17,Sheet1!F38)
MTD Costs =SUMIFS(Sheet1!E31:AO31,Sheet1!E17:AO17,Sheet1!F38)

Does le Pro mean remainder of Financial Year ?

Is your Financial Year April 1 thru to March 31

Le pro total Rev:
=SUMIFS(Sheet1!E31:AO31,Sheet1!E17:AO17,">"&Sheet1!F39,Sheet1!E17:AO17,"<"&DATE(IF(MONTH(F39)>3,YEAR(F39)+1,YEAR(F39)),4,1))

Le pro total Cost:

=SUMIFS(Sheet1!E30:AO30,Sheet1!E17:AO17,">"&Sheet1!F39,Sheet1!E17:AO17,"<"&DATE(IF(MONTH(F39)>3,YEAR(F39)+1,YEAR(F39)),4,1))
yes your right le pro mean remainder of financial year.
yes financial year start from April1st till March 31st.

thank you for formula, but how to get this in vba macro ?
 
@Hui May I know what is F39 Refer for in Le pro total cost


i guess my communication is bad, in sheet below table i given for just for explain.

below information will not be their in sheet

if Current Month MTD le pro
Jan-17 Jan-17 Feb& Mar
Apr-17 Apr-17 May 17 - Mar 18
 
Why not have a calculation on the worksheet and refer to that in the macro
 
Why not have a calculation on the worksheet and refer to that in the macro
yes , we can do that too, but still i not understand what is F39 Refer for ?

if i give current month out put is zero if i give Apr 17 out put is 75900 in revenue.

both way out is wrong.

can you suggest how to get the value has to fill automatically based on sheet1.
same macro i have to apply for some 50 files.

Kindly help me to get the macro.
 
MTD Rev =SUMIFS(Sheet1!E30:AO30,Sheet1!E17:AO17,Sheet1!F38)
MTD Costs =SUMIFS(Sheet1!E31:AO31,Sheet1!E17:AO17,Sheet1!F38)

Does le Pro mean remainder of Financial Year ?

Is your Financial Year April 1 thru to March 31

Le pro total Rev:
=SUMIFS(Sheet1!E31:AO31,Sheet1!E17:AO17,">"&Sheet1!F39,Sheet1!E17:AO17,"<"&DATE(IF(MONTH(F39)>3,YEAR(F39)+1,YEAR(F39)),4,1))

Le pro total Cost:

=SUMIFS(Sheet1!E30:AO30,Sheet1!E17:AO17,">"&Sheet1!F39,Sheet1!E17:AO17,"<"&DATE(IF(MONTH(F39)>3,YEAR(F39)+1,YEAR(F39)),4,1))
I understood the formula , its working. Thank you.
let me try same from macro out put.
 
See attached
as you mentioned , i plan to keep the current month in Excel as formula.

Range("m1").Formula = "=DATE(YEAR(TODAY()),MONTH(TODAY()),1)"

then i try to apply your formula as value in vba, i am on testing.

Thank you for your support :)
 
See attached
If you able to provide vb code for same formula , that will be great.
I find in difficult to set the range of sum.

few sheets range will till z column some will be AK column like wise
it ware , so i am trying that.
 
Last edited:
any one help me to get following formula as vb code


following code i am getting error [Run-time error '13': Type mismatch]
Code:
Range("M5").Value="=SUMIFS('Costing Delivery'!E31:AO31,'Costing Delivery'!E17:AO17,">"&'Costing Delivery'!F39,'Costing Delivery'!E17:AO17,"<"&DATE(IF(MONTH('Costing Delivery'!F39)>3,YEAR('Costing Delivery'!F39)+1,YEAR('Costing Delivery'!F39)),4,1))"

also i tried below code

error i get is [Run-time error '424': object required]

Code:
Worksheets("export").Range("M5").Value = Application.SumIfs(Range("49:49"), ">" & "Jan 17", ws.Range("17:17"), "<" & Application.Date(Application.If(Month("Jan 17") > 3, Application.Year("Jan 17") + 1, Application.Year("Jan 17")), 4, 1))
 
Hello Mr. @Hui sorry to bother you again.
as per your macro everything working fine. But if the current month is Sep 19 and above (it mean project over before current month)

Total revenue and Total LE Project should be zero.

but as per your sample file (proj1.xlsm) LE Project getting some value even after project end.

can you please correct the code and update the same ?

Thank you in advance.
Prasad
 
If I put 1/9/2019 in Sheet1!D38 I get an error when the code runs

So you have done something since I posted it?

Please post your file?
 
Hi @Hui


i am sharing my file and code , it may confuse you. i used your code end of the code.

refer the attached file. as per that project end on Nov-16 but LE pro showing some in value in Export sheet.





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

Attachments

If I put 1/9/2019 in Sheet1!D38 I get an error when the code runs

So you have done something since I posted it?

Please post your file?
If my code confusing , please use "Proj1.xlsm" should not get error , if project get over before current month, value should be zero.

please do the needful.
 
@Hui Thank you for your support.

I got the result.

added following code before "DO" so it check if the current month not in the project month it will exit.

For i = 1 To UBound(DateRng, 2)

If DateRng(1, i) = mydate Then
 
Back
Top