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

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 1 week, 1 day 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
 woody on EventViewer still broken in 1903 Just now
 Bundaburra on Update Orchestrator Service disabled and greyed out 13 minutes ago
 Elly on EventViewer still broken in 1903 1 hour, 27 minutes ago
 anonymous on Third Tuesday patches are out, but not for Win10 1903 1 hour, 59 minutes ago
 VulturEMaN on Patch Lady – well not quite ready 2 hours, 33 minutes ago
 MikeMc on Patch Lady – well not quite ready 2 hours, 43 minutes ago
 The Surfing Pensioner on Pop up from IE11 to reset my browser 3 hours, 37 minutes ago
 anonymous on Migration plan: Win7GrpB to Ubuntu & VM 3 hours, 46 minutes ago
 Elly on Special orientation for Windows Secrets veterans 3 hours, 54 minutes ago
 PKCano on Patch Lady – if you are running 1803 or earlier 3 hours, 58 minutes ago
 Elly on Patch Lady – well not quite ready 4 hours, 46 minutes ago
 WSADRIANA DELGADO on Special orientation for Windows Secrets veterans 5 hours, 5 minutes ago
 rjstorms on Need Help w/Excel 2003 Formula 5 hours, 22 minutes ago
 rjstorms on Need Help w/Excel 2003 Formula 5 hours, 25 minutes ago
 Susan Bradley on Patch Lady – well not quite ready 5 hours, 32 minutes ago
 satrow on PCI Express 5 hours, 37 minutes ago
 marklang on Saving regular documents folders in OneDrive 6 hours, 2 minutes ago
 WSNTLS on Microsoft issues KB4493132 Windows 7 SP1 support notification 6 hours, 20 minutes ago
 WSNTLS on Microsoft issues KB4493132 Windows 7 SP1 support notification 6 hours, 26 minutes ago
 NetDef on Patch Lady – well not quite ready 6 hours, 30 minutes ago
Recent Topics

If you’re running Win10 Pro 1803 and you want to move to 1809 so you don’t get pushed to 1903, there’s good news
9 minutes ago

Dell: Recent patches break iSCSI login on Dell PS Series arrays
2 hours, 14 minutes ago

Windows 10 Insider Preview build 18922 (20H1) released to FAST ring
5 hours, 22 minutes ago

Chrome – subframes
6 hours, 31 minutes ago

Patch Lady – well not quite ready
2 hours, 58 minutes ago

Free AutoHotkey ebook
10 hours, 14 minutes ago

Win 10 1903 update
11 hours, 54 minutes ago

Customize the initial Windows 10 installation
9 hours, 40 minutes ago

Third Tuesday patches are out, but not for Win10 1903
2 hours, 24 minutes ago

Windows 10 1803, 1809 June 18 updates
16 hours, 21 minutes ago

Patch Lady – if you are running 1803 or earlier
16 minutes ago

PCI Express
6 hours, 2 minutes ago
Search for Topics
Recent blog posts
 If you’re running Win10 Pro 1803 and you want to move to 1809 so you don’t get pushed to 1903, there’s good news
 Dell: Recent patches break iSCSI login on Dell PS Series arrays
 Patch Lady – well not quite ready
 Third Tuesday patches are out, but not for Win10 1903
 Patch Lady – if you are running 1803 or earlier
 Bugs with Win10 1809 June cumulative update and Realtek Bluetooth, Avast won’t play with 1903, and black screens on reboot
 Microsoft finally got OneDrive right
 Are we ready for the new Windows 10 1903?