macro to add numbers based on set criteria

  • Thread starter Thread starter David
  • Start date Start date
D

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
 
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
 
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
 
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.
 
Hi Joel,

I got an error message "Argument not optional" and it highlights the first
line LastRow
 
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
 
Back
Top