VBA Loop Until Positive Balance is Achieved

[hexagonwrench]

<!--StartFragment-->Hi ExcelVBA Gurus,

I hopeyou guys are doing well. I am trying to create a code using IF statement for myFunding file.

Where ina Vendor is paid if Invoice (positiveamount) is > Credit Memo (negative amount) on a particular due date.

If thenegative amount is greater than Invoices on a particular due date. Then thoseinvoices will be (either negative or positive) will be compared to the next duedate that has enough Invoices to cover the negative amounts.

Once thiscondition has been achieved a new due date will be added to a new column whenthe positive total has been achieved. The new due date for the new column isthe date when a particular row of an invoice can cover or equal the negativeamounts.

Below isthe raw data that I used for my testing.

Doc Date DocNo Vendor No VendorName Amount Due Date 19-Oct-14 12345 1010 TenTen 40000 23-Oct-14 19-Oct-14 12346 1010 TenTen 40000 23-Oct-14 20-Oct-14 12347 1010 TenTen 40000 23-Oct-14 23-Oct-14 12350 1010 TenTen -125000 23-Oct-14 21-Oct-14 12348 1020 TenTwenty 50000 23-Oct-14 22-Oct-14 12349 1020 TenTwenty 40000 23-Oct-14 24-Oct-14 12351 1010 TenTen 125000 24-Oct-14 25-Oct-14 12352 1010 TenTen -50000 24-Oct-14 <tbody> </tbody>

<tbody>
</tbody>

<!--EndFragment-->I tried using the recorder to see where I can edit and add if statements but I don't know where to start.Below is the code.

<!--StartFragment-->Columns("D:D").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.AddKey:=Range("D2:D9"), _
SortOn:=xlSortOnValues,Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.AddKey:=Range("F2:F9"), _
SortOn:=xlSortOnValues,Order:=xlAscending, DataOption:=xlSortNormal
WithActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:F9")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1:F9").Select
Columns("E:F").Select
Selection.Subtotal GroupBy:=2,Function:=xlSum, TotalList:=Array(1), _
Replace:=True, PageBreaks:=True,SummaryBelowData:=True
Range("J12").Select
End Sub

Below is the result:

Doc Date	DocNo	Vendor No	VendorName	Amount	Due Date
19-Oct-14	12345	1010	TenTen	40000	23-Oct-14
19-Oct-14	12346	1010	TenTen	40000	23-Oct-14
20-Oct-14	12347	1010	TenTen	40000	23-Oct-14
23-Oct-14	12350	1010	TenTen	-125000	23-Oct-14
				-5000	23-Oct-14 Total
24-Oct-14	12351	1010	TenTen	125000	24-Oct-14
25-Oct-14	12352	1010	TenTen	-50000	24-Oct-14
				75000	24-Oct-14 Total
21-Oct-14	12348	1020	TenTwenty	50000	23-Oct-14
22-Oct-14	12349	1020	TenTwenty	40000	23-Oct-14
				90000	23-Oct-14 Total

<tbody>
</tbody>

<!--EndFragment-->However I think the code can still be improved and can be created in a loop structure.
Also how can I add a condition statement wherein if that subtotal for a particular vendor on a particular due date is a negative, say Oct 23 of Vendor TenTen subtotal of -5000 will be subtracted to invoices dated Oct 24. A new column will be added to for those invoices dated Oct 23 to indicate the new due date as Oct 24. Oct 24 is the new due date because it can offset the -5000 and -50000. For those that doesn't need any changing on the thier due date this is copied in the new column.

Hope to get your inputs.