Option Explicit
Public Sub ParseYrs()
Dim vCode, vDesc, vStart, vEnd, vYr, vYrAmt, vAmt, vPrevYr
Dim vStartDte As Date, vEndDte As Date, vDte As Date
Dim colYrs As New Collection
Dim i As Integer, iYr As Integer
Dim wsSrc As Worksheet, wsTarg As Worksheet
Set wsSrc = ActiveSheet
Sheets.Add
Set wsTarg = ActiveSheet
Range("A1").Value = "Code"
Range("B1").Value = "Desc"
Range("c1").Value = "Period"
Range("d1").Value = "Value"
Range("A2").Select
wsSrc.Activate
Range("A2").Select
While ActiveCell.Value <> ""
vCode = ActiveCell.Offset(0, 0).Value
vDesc = ActiveCell.Offset(0, 1).Value
vStart = ActiveCell.Offset(0, 2).Value
vEnd = ActiveCell.Offset(0, 3).Value
'collect the amounts for each year
For i = 1 To 5
vAmt = ActiveCell.Offset(0, i + 3).Value
colYrs.Add vAmt, CStr(i)
Next
vStartDte = Month(vStart) & "/1/" & Year(vStart)
vEndDte = Month(vEnd) & "/1/" & Year(vEnd)
vEndDte = DateAdd("m", 1, vEndDte)
'post values in target sheet
wsTarg.Activate
vDte = vStartDte
iYr = 0
While vDte < vEndDte
vYr = Year(vDte)
If vYr <> vPrevYr Then
iYr = iYr + 1
If iYr > colYrs.Count Then GoTo endPost
End If
'post results
ActiveCell.Offset(0, 0).Value = vCode
ActiveCell.Offset(0, 1).Value = vDesc
ActiveCell.Offset(0, 2).Value = vDte
ActiveCell.Offset(0, 3).Value = colYrs(iYr)
ActiveCell.Offset(1, 0).Select 'next row
If vDte > vEnd Then GoTo endPost
vDte = DateAdd("m", 1, vDte)
vPrevYr = vYr
Wend
endPost:
'back to src sheet
wsSrc.Activate
ActiveCell.Offset(1, 0).Select 'next row
vPrevYr = 0
Set colYrs = New Collection
Wend
'show results
wsTarg.Activate
Set wsSrc = Nothing
Set wsTarg = Nothing
Set colYrs = Nothing
End Sub