macro to add numbers based on set criteria

[David]

Hi Everyone,

i am trying to create a macro that will add numbers based on set criteria
here is an example

I have a file over 20K lines and about 200 columns which contain the
following headings

Contract # Min date Max date
55 01/01/09 05/10/09
200 10/11/06 12/22/07
350 11/14/05 01/08/06

and i havea nother sheet in the same file with records of over 70K, which
keeps the payments records, and contains the following headings

Contract # Posting date Amount
55 03/10/09 100.00
200 11/15/06 80.00
55 02/02/06 200.00
350 12/11/05 500.00
55 02/28/09 90.00
55 07/22/09 22.00

i want the macro to add the amount column for each contract with posting
date the falls between min date and max date.

I appreciate any help i can get

thanks
david

 

[Joel]

With large amount of data like this I wouldn't put a formula into a worksheet
because it would be very slow. Instead I would use an evaluate like below.
I made sheet 1 your first table and sheet 2 the 2nd table.

Sub GetTotals()
With Sheets("Sheet2")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set contractNum = .Range("A2:A" & LastRow)
Set contractDate = .Range("B2:B" & LastRow)
Set contractAmount = .Range("C2:C" & LastRow)

End With

With Sheets("sheet1")
RowCount = 2
Do While .Range("A" & RowCount) <> ""
contract = .Range("A" & RowCount)
MinDate = .Range("B" & RowCount)
MaxDate = .Range("C" & RowCount)

Total = Evaluate("Sumproduct(" & _
"--(" & contract & "=" & contractNum.Address(external:=True) &
")," & _
"--(" & MinDate & "<=" & contractDate.Address(external:=True) &
")," & _
"--(" & MaxDate & "=>" & contractDate.Address(external:=True) &
")," & _
"(" & contractAmount.Address(external:=True) & "))")
.Range("D" & RowCount) = Total
RowCount = RowCount + 1
Loop
End With

End Sub

 

[David]

Hi Joel,

Thanks for the codes, however its not working the result are value

 

[Joel]

There was two problems with the code

1) I had => instead of >=
2) The function sumproduct wanted a string date and not a number date. Made
some minor changes. I converted the dates on the worksheet to string using a
Format function. Then had to convert the string date back to a number date
using DateValue. The Associate Principal in math does not apply to VBA code.
UGH!!!!!!!!

Sub GetTotals()

With Sheets("Sheet2")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set contractNum = .Range("A2:A" & LastRow)
Set contractDate = .Range("B2:B" & LastRow)
Set contractAmount = .Range("C2:C" & LastRow)

End With

With Sheets("sheet1")
RowCount = 2
Do While .Range("A" & RowCount) <> ""
contract = .Range("A" & RowCount)
MinDate = Format(.Range("B" & RowCount), "MM/DD/YYYY")
MaxDate = Format(.Range("C" & RowCount), "MM/DD/YYYY")

Total = Evaluate("Sumproduct(" & _
"--(" & contract & "=" & contractNum.Address(external:=True) & _
")," & _
"--(DateValue(""" & MinDate & """)<=" &
contractDate.Address(external:=True) & _
")," & _
"--(DateValue(""" & MaxDate & """)>=" &
contractDate.Address(external:=True) & _
")," & _
"(" & contractAmount.Address(external:=True) & "))")
.Range("D" & RowCount) = Total
RowCount = RowCount + 1
Loop
End With

End Sub

 

[Joel]

Just as a reminder the Associate Proincipal of math says

if A = B and B = C then A = C.

In this case A didn't equal C (it should of) , but going from A to B and
then B to C got the correct answer.

 

[David]

Hi Joel,

I got an error message "Argument not optional" and it highlights the first
line LastRow

 

[Joel]

the lengths of the lines were too long and the posting add additional lines
which cause errors. I slighlty modified the code to prevent this from
happening.

Sub GetTotals()

With Sheets("Sheet2")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set contractNum = .Range("A2:A" & LastRow)
Set contractDate = .Range("B2:B" & LastRow)
Set contractAmount = .Range("C2:C" & LastRow)

End With

With Sheets("sheet1")
RowCount = 2
Do While .Range("A" & RowCount) <> ""
contract = .Range("A" & RowCount)
MinDate = Format(.Range("B" & RowCount), "MM/DD/YYYY")
MaxDate = Format(.Range("C" & RowCount), "MM/DD/YYYY")

Total = Evaluate("Sumproduct(" & _
"--(" & contract & "=" & contractNum.Address(external:=True) & _
")," & _
"--(DateValue(""" & MinDate & """)<=" & _
contractDate.Address(external:=True) & ")," & _
"--(DateValue(""" & MaxDate & """)>=" & _
contractDate.Address(external:=True) & _
")," & _
"(" & contractAmount.Address(external:=True) & "))")
.Range("D" & RowCount) = Total
RowCount = RowCount + 1
Loop
End With

End Sub