Loop to find if a date exists in a range of dates 2

[nikniknik]

Hi,

I am a novice user when it comes to VBA, so any help will be greatly appreciated. This is what I'm trying to do:

In my excel work sheet, column A is my start date, column B is my end date and column C are dollar amounts. For example,

31-Jan-03 03-Feb-03 3
03-Dec-02 03-Feb-03 62
03-Jan-03 05-Feb-03 33
27-Dec-02 05-Feb-03 40
06-Nov-02 05-Feb-03 91
06-Jan-03 06-Feb-03 31
31-Jan-03 07-Feb-03 7
03-Feb-03 10-Feb-03 7
07-Jan-03 12-Feb-03 36
13-Nov-02 12-Feb-03 91
07-Feb-03 13-Feb-03 6
06-Feb-03 14-Feb-03 8
08-Jan-03 17-Feb-03 40
18-Nov-02 17-Feb-03 91
20-Nov-02 18-Feb-03 90
13-Feb-03 19-Feb-03 6
19-Nov-02 19-Feb-03 92
19-Feb-03 20-Feb-03 1
21-Jan-03 20-Feb-03 30
24-Jan-03 21-Feb-03 28
23-Jan-03 21-Feb-03 29
22-Jan-03 21-Feb-03 30
21-Jan-03 21-Feb-03 31

In column D, I have a series of dates (i.e. 1-feb-03, 2-feb-03, 3-feb-03....21-feb-03).

Okay, here's what I want to do. For each date in column D, I want to find if it is contained in each range (i.e. row 1, row 2, etc). If it is contained in that range, I want to grab the value in column C, sum them up and spit out the result beside the respective date in column E.

Too make it more confusing...I will be adding more date ranges to the list, so the loop has to work to accomodate this, so I was thinking that a "IsNotEmpty" funtion would work.

I have no idea where to begin....PLEASE help!

nik

 

[Yesuslave]

You will be adding new date ranges to which column?

 

[nikniknik]

I will be adding more start and end dates to the list on an ad hoc basis.

nik

 

[xlbo]

Assuming data starts in row 2

Sub DoStuff()
dim lRow as long, stDate as date, enDate as date, TempSum as double, lRowD as long, chkDate as date

lRow = cells(65536,1).end(xlup).row
lRowD = cells(65536,4).end(xlup).row
for i = 2 to lRowD
chkDate = cells(i,4).value
TempSum = 0
for x = 2 to lRow
stDate = cells(x,1).value
enDate = cells(x,2).value
if chkDate >= stDate and chkDate <= enDate then
TempSum = TempSum + cells(x,3).value
end if
next x
cells(i,5).value = Tempsum
next i
end sub

Rgds, Geoff
[blue]Si hoc signum legere potes, operis boni in rebus Latinus alacribus et fructuosis potiri potes![/blue]
Want the [red]best[/red] answers to your questions ? faq222-2244

 

[TonyJollans]

Hi nikniknik,

Just for a change, I'll give the non-VBA option. This formula in E1 beside your date in D1 (and copied down as far as your dates go) should do it:

=SUMPRODUCT((D1>=OFFSET($A$1,0,0,COUNTA($A:$A),1))*(D1<=OFFSET($B$1,0,0,COUNTA($A:$A),1))*(OFFSET($C1,0,0,COUNTA($A:$A),1)))

It would be easier to work with if you set up names for the dynamic ranges. Under Insert > Name > Define, enter ..

Name: StartDates
Refers To: =OFFSET($A1,0,0,COUNTA($A:$A),1)
Press Add

Name: EndDates
Refers To: =OFFSET($B1,0,0,COUNTA($A:$A),1)
Press Add

Name: Dollars
Refers To: =OFFSET($C1,0,0,COUNTA($A:$A),1)
Press Add

And now your formula becomes:

=SUMPRODUCT((D1>=StartDates)*(D1<=EndDates)*(Dollars))

Enjoy,
Tony

------------------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading FAQ222-2244 before you ask a question.

 

[Zathras]

I highly recommend Geoff's solution. It is very elegant and meets your requirements.

On the other hand, in case you prefer a non-VBA solution, Excel has the built-in capability to do what you want. It's called a 1-way data table. If you wish to learn how to use it, read on. Otherwise you can simply ignore this post.

Assuming your data are in a proper list with column headings, then you can specify a cell to use as the column input cell, set up a criteria range, and define one DSUM formula.

For your test data (assuming starting in row 2), set up the following cells:
[blue]

A1: FromDate
B1: ThruDate
C1: Quantity
D1: TestDate
E1: =DSUM($A$1:$C$24,3,$I$1:$J$2)
G1: =D2
I1: FromDate
J1: ThruDate
I2: =&quot;<=&quot;&$G$1
J2: =&quot;>=&quot;&$G$1

[/color]
Select the range D122
Choose Data/Table... from the menu
Click in &quot;Column input cell:&quot;
Click on G1
Click OK

Strictly speaking, you can leave cell G1 blank, but by having an entry there it is harder to forget that the cell is used. On the other hand, if you leave it blank and use this version of the formula in E1...
[blue]

  =IF(G1="","Sum of Quantity",DSUM($A$1:$C$24,3,$I$1:$J$2))

[/color]
...you can improve the appearance of the worksheet.

 

[nikniknik]

Thanks everyone!!!!

I'm gonna give it a try and see what happens.

 

[nikniknik]

Geoff,

I have modified to code to fit my workbook and I am getting a subscript out of range error. See code below:

Sub Loop1()

Dim lRow As Long, IssDate As Date, MatDate As Date, Sum As Double, lRowD As Long, chkDate As Date

lRow = Worksheets(&quot;Comet A - Outstanding&quot.Cells(1232, 3).End(xlUp).Row
lRowD = Worksheets(&quot;Comet A - Principal&quot.Cells(550, 1).End(xlUp).Row
For i = 7 To lRowD
chkDate = Worksheets(&quot;Comet A - Principal&quot.Cells(i, 1).Value
Sum = 0
For x = 22 To lRow
IssDate = Worksheets(&quot;Comet A - Outstanding&quot.Cells(x, 3).Value
MatDate = Worksheets(&quot;Comet A - Outstanding&quot.Cells(x, 4).Value
If chkDate >= IssDate And chkDate < MatDate Then
Sum = Sum + Worksheets(&quot;Comet A - Outstanding&quot.Cells(x, 11).Value
End If
Next x
Worksheets(&quot;Comet A - Principal&quot.Cells(i, 4).Value = Sum
Next i
End Sub

As you can see, I am working out of mulitlbe sheets. Basically, my start date, end date, and dollar amounts are in one worksheet. My checkdates and the column I want to spit the result in are in another worksheet.

Do you see the problem in the code?

Thanks for your help,

nik

 

[xlbo]

Well - you could've mentioned that in the 1st place....

Assuming Start Date in Col A &quot;Outstanding&quot; sheet
End Date in Col B &quot;Outstanding&quot; sheet
Dollars in Col C &quot;Outstanding&quot; sheet

Check Dates in Col A on &quot;Principal&quot; sheet and start at row 7

Don't know why you bothered renaming the variables - they are just that - variables

Sub DoStuff()
dim lRow as long, stDate as date, enDate as date, TempSum as double, lRowD as long, chkDate as date

lRow = sheets(&quot;Comet A - Outstanding&quot.cells(65536,1).end(xlup).row
lRowD = sheets(&quot;Comet A - Principal&quot.cells(65536,4).end(xlup).row
for i = 7 to lRowD
chkDate = sheets(&quot;Comet A - Principal&quot.cells(i,4).value
TempSum = 0
for x = 2 to lRow
stDate = sheets(&quot;Comet A - Outstanding&quot.cells(x,1).value
enDate = sheets(&quot;Comet A - Outstanding&quot.cells(x,2).value
if chkDate >= stDate and chkDate <= enDate then
TempSum = TempSum + cells(x,3).value
end if
next x
sheets(&quot;Comet A - Principal&quot.cells(i,5).value = Tempsum
next i
end sub

Rgds, Geoff
[blue]Si hoc signum legere potes, operis boni in rebus Latinus alacribus et fructuosis potiri potes![/blue]
Want the [red]best[/red] answers to your questions ? faq222-2244