MSDEFCON 2:
Patch reliability is unclear. Unless you have an immediate, pressing need to install a specific patch, don't do it.


Sum values between two dates by VBA code
Home › Forums › AskWoody support › Productivity software by function › MS Excel and spreadsheet help › Sum values between two dates by VBA code
This topic contains 20 replies, has 8 voices, and was last updated by zeddy 3 months, 1 week ago.

AuthorPosts

I hope someone will guide me to write the VBA code without showing formulas in the result cell to get the below answer
In the below dropbox linked file:
Column A8:A1000 I have production date (112015 to 31122017)Column B8:B1000 I have Sales date (112015 to 31122017)Column C8:C1000 I have Production QuantityColumn D8:D1000 I have Sales Quantity In cell E2 Start date is 332015In cell E3 End date is 992017In cell E4 i need a total of column C, in between the D2 and D3 dates of Column A (Production quantity between those dates)In cell E5 i need a total of column D, in between the D2 and D3 dates of Column B (Sales quantity between those dates)
https://www.dropbox.com/s/ifdak1vx82xgb5w/Sum%20Between%20two%20dates.xlsx?dl=0
Edit to remove HTML. Please use the “Text” tab in the entry box when you copy/paste.

I don’t profess to be a VBA expert, but I think this does what you want:
Code:Sub SumBetween() Sheets("Sheet1").Range("E4").Formula = "=SUMPRODUCT((A8:A15000>E2)*(A8:A15000<E3)*(C8:C15000))" Sheets("Sheet1").Range("E4") = Sheets("Sheet1").Range("E4").Value Sheets("Sheet1").Range("E5").Formula = "=SUMPRODUCT((B8:B15000>E2)*(B8:B15000<E3)*(D8:D15000))" Sheets("Sheet1").Range("E5") = Sheets("Sheet1").Range("E5").Value End Sub
1 user thanked author for this post.

This is not meant to dissuade your pursuit of a solution in VBA but for my simpler needs I tend to rely upon the Julian calendar where each day in the year had a number, 1 to 365 or 1 to 366, an example would be rather simple to use current day of 126 and subtract a previous day such as 85 to get the difference from March 26. The US Government and Military always had the Julian date included on their calendars, don’t know if they ever stopped that practice since I retired 25 years ago.
Before you wonder "Am I doing things right," ask "Am I doing the right things?" 
Or if you’re interested in a non VBA solution these formulas will do the trick.
e4:=SUMIFS(C8:C5187,A8:A5187,">="&E2,A8:A5187,"< ="&E3) e5:=SUMIFS(D8:D5187,B8:B5187,">="&E2,B8:B5187,"< ="&E3)
Note: Your sample file had dates way past row 1000 so I used the rows that contained dates. I'd recommend using dynamic range names so that when you add rows the ranges are automatically adjusted. I'd also assign range names to the beginning & ending dates.
HTH 😎

Hey, RG…glad to see you’re logging in!!
BTW: if the OP still wanted VBA, SUMIFS doesn’t work there, does it? I didn’t think so, which is why I used SUMPRODUCT. I guess you can use Application.WorksheetFunction.SUMIFS…right?
Oh, and I took him literally when he said “between” and didn’t include the =.


Kevin.
You know I love VBA but it isn’t always the best solution. If the OP doesn’t want the formulas to show he could protect those cells then protect the sheet uncheck the option allowing the selection of protected cells thereby hiding the formulas.
HTH 😎
1 user thanked author for this post.

Hey, RG…glad to see you’re logging in!!
BTW: if the OP still wanted VBA, SUMIFS doesn’t work there, does it? I didn’t think so, which is why I used SUMPRODUCT. I guess you can use Application.WorksheetFunction.SUMIFS…right?
Oh, and I took him literally when he said “between” and didn’t include the =.
FWIW, you could use SUMIFS equally as well as you used SUMPRODUCT there. It’s just a formula.

Dear All
The below code is working fine except when I select (“EN6”) value in the cell (“P1”) dropdown list because it is an index match formula and all others are sumproduct. The sumproduct I got results after many website searching.
Just go through the code and give me a solution to get the results when I select EN6 value in the cell P1.
Thanks in advance
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim J As Range, G As Range, Where As Range
Dim Low As Date, High As Date
Dim Dates, Types, Values
Dim i As Long
Dim Sum As Double, Sum1 As Double, Sum2 As Double
'Only if P1 changes
If Intersect(Target, Range("P1")) Is Nothing Then Exit Sub
'Get the dates
Low = Range("EO1").Value
High = Range("EN1").Value
'Refer to the used cells in column J
Set J = Range("J8", Range("J" & Rows.Count).End(xlUp))
'Same size in column G
Set G = Intersect(Columns("G"), J.EntireRow)
'Read in all data
Dates = J.Value
Types = G.Value
Select Case Target.Value
Case Range("EN2").Value
'Same size in column CF
Set Where = Intersect(Columns("CF"), J.EntireRow)
'Read in all values
Values = Where.Value
'Process the SUMPRODUCT
For i = 1 To UBound(Dates)
If Dates(i, 1) >= Low And Dates(i, 1) <= High And Types(i, 1) = "Sales" Then
Sum = Sum + Values(i, 1)
End If
Next
Case Range("EN3").Value
Set Where = Intersect(Columns("T"), J.EntireRow)
Values = Where.Value
For i = 1 To UBound(Dates)
If Dates(i, 1) >= Low And Dates(i, 1) <= High And Types(i, 1) = "Sales" Then
Sum = Sum + Values(i, 1)
End If
Next
Case Range("EN4").Value
Set Where = Intersect(Columns("B"), J.EntireRow)
Dates = Where.Value
Set Where = Intersect(Columns("CF"), J.EntireRow)
Values = Where.Value
For i = 1 To UBound(Dates)
If Dates(i, 1) <= High Then
Sum1 = Sum1 + Values(i, 1)
End If
Next
Set Where = Intersect(Columns("CA"), J.EntireRow)
Values = Where.Value
Dates = J.Value
For i = 1 To UBound(Dates)
If Dates(i, 1) <= High Then
Sum2 = Sum2 + Values(i, 1)
End If
Next
Sum = Sum1  Sum2
Case Range("EN5").Value
Set Where = Intersect(Columns("BY"), J.EntireRow)
Values = Where.Value
'Process the SUMPRODUCT
For i = 1 To UBound(Dates)
If Dates(i, 1) >= Low And Dates(i, 1) <= High And Types(i, 1) = "Sales" Then
Sum = Sum + Values(i, 1)
End If
Next
Case Range("EN6").Value
Dim CG4EF4
CG4EF4 = Range("CG4:EF4").Value
With Worksheets("RM Price")
'Note the . in front of Range:
Set Where = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
Set Where = Intersect(.Columns("B:BA"), Where.EntireRow)
End With
Values = Where.Value
Case Range("EN7").Value
Set Where = Intersect(Columns("B"), J.EntireRow)
Dates = Where.Value
Set Where = Intersect(Columns("CE"), J.EntireRow)
Values = Where.Value
For i = 1 To UBound(Dates)
If Dates(i, 1) <= High Then
Sum1 = Sum1 + Values(i, 1)
End If
Next
Set Where = Intersect(Columns("BZ"), J.EntireRow)
Values = Where.Value
Dates = J.Value
For i = 1 To UBound(Dates)
If Dates(i, 1) <= High Then
Sum2 = Sum2 + Values(i, 1)
End If
Next
Sum = Sum1  Sum2
End Select
'Events off, otherwise we call ourself
Application.EnableEvents = False
'Write the sum into the sheet
Range("EL7") = Sum
'Events on
Application.EnableEvents = True
End Sub

How about something like this:
Public Sub SumProdSales()
Dim I As Long
Range("E4") = ""
Range("E5") = ""
LR1 = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
LR2 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
If LR1 >= LR2 Then LR = LR1 Else LR = LR2
For I = 8 To LR
If Cells(I, 1) >= Range("E2") And Cells(I, 1) <= Range("E3") Then
Range("E4") = Range("E4") + Cells(I, 3)
End If
If Cells(I, 2) >= Range("E2") And Cells(I, 1) <= Range("E3") Then
Range("E5") = Range("E5") + Cells(I, 4)
End If
Next I
End SubHTH,
Maud
1 user thanked author for this post.

See attached file
zeddy

In my attached file in the previous post, ignore the .pdf file extension, it’s really an excel .xlsb file. But you can’t post .xlsb file types here, so apologies for tricking the system.
In the posted file, I used the worksheet change event to detect if the Start Date or End Date was changed. If a date is changed, the result is then recalculated using vba.
My calc formula uses the entire columns. It is simple, and effective.
zeddy

Ignore my previous 2 posts – seems like I didn’t trick the system after all!
So I will now try and work out how to post the block of vba code I used.
I tried to wrap it using
Code:and
but the system here didn’t like that.
zeddy

Ok I’ll try this:
Code:Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [e2:e3]) Is Nothing Then 'changed date cell detected zProductionQty = [=SUMIFS(C:C,A:A,">="&E2,A:A,"<="&E3)] 'calculate value zSalesQty = [=SUMIFS(D:D,B:B,">="&E2,B:B,"<="&E3)] 'calculate value [e4] = zProductionQty 'put value in cell [e5] = zSalesQty 'put value in cell End If End Sub
zeddy

In my previous post, put that into the sheetcodemodule.
zeddy

Ok, trying to post a copy of the .xlsx file without the sheet code.
Attachments:
You must be logged in to access attached files.

OK, trying again
to attach the camouflaged .xlsb file as a “pdf” file..
zeddy

It seems we can’t post any excel .xlsm files.
This is a pity, it would be more convenient. And if the reasoning is because people are worried about macro viruses, then I would say get yourself a virus protection program. They are available. Just saying. It is tedious to have to post code that has to be then copied into files.
I liked Kevin’s method of putting a formula into the cells via vba, then converting the formulas to values, as the OP didn’t want to see any formulas. A nice touch to use 15000 in the formulas to allow for plenty of extra record rows. But since you can now refer to entire columns in formulas, without incurring unwanted calc overhead (only usedrangerows are actually used), you can effectively allow for over 1 million record rows.
I liked RG’s suggestion about using dynamic range names, but using entirecolumn references in the SUMIFS formulas means you don’t need to. Using sheet protection to lock and hide the formula cells is a really great suggestion – it would stop anyone just overtyping the resultscells to put whatever values they ‘wanted to see’.
Maudibe’s nice vba routine is easy to follow, and you can understand what’s going on.
zeddy
 This reply was modified 3 months, 1 week ago by zeddy.
1 user thanked author for this post.

Zeddy,
Thanks for the heads up on using whole column references in SUMIF, I was unaware of that change. Guess it’s time to hit the documentation and see what other changes I have missed…LOL. 😎

Hi RG
I’m hitting the documentation too!
I’m only now getting used to the term “spill” for Excel. The <b>spill range</b> relates to the new output ranges of Dynamic Array formulas, which are replacing Ctrl+Shift+Enter (CSE) formulas. If something is blocking the output spill range, you will see a new #error type: #SPILL!
And we can refer to these spill ranges e.g. when defining the Source range for a Data Validation list, e.g. Source: =F2#
F2# refers to the entire range of spill data. F2 is the first cell in the spill range. Adding the # to the cell ref turns it into a reference for the entire spill range.
These new functions are not yet available on general release, but you can read up on them to get a step ahead.
zeddy
Carp Diem
(Fish of the day)

AuthorPosts


It's easy to post questions about Windows 10, Win8.1, Win7, Surface, Office, or browse through our Forums. Post anonymously or register for greater privileges. Keep it civil, please: Decorous Lounge rules strictly enforced. Questions? Contact Customer Support.
Plus Membership
AskWoody Plus members not only get access to all of the contents of this site  including Susan Bradley's frequently updated Patch Watch listing  they also receive weekly AskWoody Plus Newsletters (formerly Windows Secrets Newsletter) and AskWoody Plus Alerts, emails when there are important breaking developments. Click here for details and to sign up.
Search The Lounge
Recent Replies
 anonymous on HP AllinOne won't scan all of a sudden 11 minutes ago
 Mark on Suggestions for keeping neighbors off your WiFi 19 minutes ago
 b on Bad update list for 2019 1 hour, 16 minutes ago
 bbearren on Admin rights? 1 hour, 25 minutes ago
 bbearren on After updates paused unable to resume updates 1 hour, 37 minutes ago
 Rydan on Admin rights? 1 hour, 42 minutes ago
 anonymous on Strategem re:WU for newly set Win8.1 OS please. 1 hour, 44 minutes ago
 joep517 on How can Web Search be disabled in 1903? 2 hours, Just now
 cmptrgy on Windows immediately restarts after shutdown 2 hours, 26 minutes ago
 wwwolf on Bad update list for 2019 2 hours, 27 minutes ago
 mn on HP AllinOne won't scan all of a sudden 2 hours, 34 minutes ago
 PKCano on Considerations migrating from Win7 to Win10 3 hours, 3 minutes ago
 anonymous on Considerations migrating from Win7 to Win10 3 hours, 4 minutes ago
 anonymous on Microsoft removes the update block for August Win7 patches on Symantec/Norton systems 3 hours, 49 minutes ago
 shazzad.arla on Data processing using VBA code. 4 hours, 3 minutes ago
 anonymous on Changes to the volume licensing Software Assurance program 4 hours, 15 minutes ago
 pinwheel.galaxy on Strategem re:WU for newly set Win8.1 OS please. 4 hours, 27 minutes ago
 mn on Considerations migrating from Win7 to Win10 4 hours, 36 minutes ago
 JimT777 on VirtualBox Install Issue 4 hours, 44 minutes ago
 shazzad.arla on Merging data of several sheets into a single sheet using VBA. 5 hours, 5 minutes ago
Recent Topics

A moderate view of Windows Update for version 1903
1 hour, 12 minutes ago

How can Web Search be disabled in 1903?
2 hours ago

Strategem re:WU for newly set Win8.1 OS please.
1 hour, 44 minutes ago

Data processing using VBA code.
4 hours, 3 minutes ago

Microsoft extends Exchange Server 2010 EOL by popular demand
9 hours, 17 minutes ago

Cox Communications & email cutback
7 hours, 26 minutes ago

Watch out for returned Amazon merch being sold as "new"
15 hours, 52 minutes ago

Do I still need KB4512506
10 hours, 21 minutes ago

Changes to the volume licensing Software Assurance program
4 hours, 15 minutes ago

Bad update list for 2019
1 hour, 16 minutes ago

Backups and Ransomware
9 hours, 2 minutes ago

Firefox Ad Free Browser
20 hours, 5 minutes ago
Search for Topics
Recent blog posts
 Changes to the volume licensing Software Assurance program
 Yet another bug with this months Win10 1903 cumulative update: PIN knockout
 Coming soon: Windows Secrets Newsletter archives!
 A ‘tip of the iceberg’ problem with RPV
 The patch waiting game — September edition
 Freeware Spotlight — TweakPower
 Patch Lady Podcast for Sept 15 2019
 Yet another bug in Win10 1903: Upgrade may knock out certain WiFi cards
Copyright © 2019 AskWoody LLC. All rights reserved.