populating monthly costs in excel sheets...

[neil]

Hi,

I have a table with the data laid out as follows

ID EOMStart_Date Freq Amount
1 30/04/2009 12 12000
2 31/05/2009 3 12000
2 31/08/2009 3 15000
3 30/04/2009 1 12000
3 31/05/2009 1 12000
3 30/06/2009 1 12000
4 31/05/2009 12 12000
5 30/06/2009 12 12000


The idea is to ascertain the total month cost across each contractID,

For eg..
ID Apr-09 May-09 Jun-09 Aug-09 Sep-09 oct-09 Nov-09 .... to Mar-09
1 1000 1000 1000 1000 1000 1000 1000 ..... 1000
2 0 4000 4000 5000 5000 5000 5000 ..... 5000
3 12000 12000 12000 12000 12000 12000 12000 ..... 12000
4 0 1000 1000 1000 1000 1000 1000 .... 1000
5 0 1000 1000 1000 1000 1000 1000 ..... 1000
Total 13000 19000 19000 20000 20000 20000 20000 .... 20000

I have about 30000 rows of contracts, & I'm sure there's an easier way of
doing this besides endless cups of coffee & a very sore back after hundreds
of hours of manual typing.....

Any help sincerly appreciated!

Neil

 

[neil]

Apologies, I missed this out
1. the amount is divided by the frequency to give the value in each cell for
the relevant month .
2. the number of month columns filled out is also defined by the Frequency

Thanks

 

[Patrick Molloy]

add a module to the project (ALT+F11, then INSERT/MODULE) and paste this code


Option Explicit
Sub Main()
Dim thisDate As Date
Dim cl As Long
Dim rw As Long
Dim targetrow As Long
Dim res As Worksheet
Dim act As Worksheet

Set act = ActiveSheet
Set res = Worksheets.Add(after:=ActiveSheet)

With act
thisDate = WorksheetFunction.Min(.Range("B:B"))
thisDate = DateSerial(Year(thisDate), Month(thisDate), 1)
res.Rows(1).NumberFormat = "@" ' set to text
For cl = 2 To 25 ' probably really on need 12 columns
res.Cells(1, cl) = Format$(thisDate, "mmm-yy")
thisDate = DateSerial(Year(thisDate), Month(thisDate) + 1, 1)
Next
res.Range("A1") = "ID"
For rw = 2 To .Range("B1").End(xlDown).Row
thisDate = .Cells(rw, 2)
thisDate = DateSerial(Year(thisDate), Month(thisDate) + 1, 1)
cl = WorksheetFunction.Match(Format$(thisDate, "mmm-yy"), res.Range("1:1"),
False)
targetrow = res.Cells(Rows.Count, 1).End(xlUp).Row + 1
res.Cells(targetrow, 1) = .Cells(rw, 1)
For cl = cl To cl + .Cells(rw, 3) - 1
res.Cells(targetrow, cl) = .Cells(rw, 4) / .Cells(rw, 3)
Next

Next

End With


End Sub

 

[neil]

Thanks Patrick..

It did the major part of the work for me.

Neil