Additional problem related to 1016964-split-of-data-into-seperate-rows-using-a-date-range

Hi,

I've already got some really good help solving a split of data.
http://www.excelforum.com/excel-prog...ml#post3729492

Original problem was this

Every entry contains basic data of a person that should stay the same for every row. In the example file there are 3 columns that contains the following; total hours, number of days and a starting date.

I need to split the hours (column I) evenly on as many rows as it says in (column J) and I need to add individual dates for each row starting from the start date in (column O).

I now encountered a new major problem related to this. The number in the J column can apparently be negative to indicate that something were taken away from the database. I need the negative numbers to be treated as a positive number for the split but then displayed as negative number again.

Included is an example file with input and needed output. In that file the macro created by watersev for the original problem is included. All credits to watersev!!

I got help from a friend who could solve it.

Option Explicit
Option Compare Text

Sub test()

Dim sh As Worksheet, lrow As Long, row_count As Long, col_count As Long, data, result, temp As Double, hours_pd As Double
Dim i As Long, m As Long, n As Long, j As Long, amount As Double, idate As Date, amount_col As Long, date_col As Long

Set sh = Sheets("Input")

lrow = sh.Cells(Rows.Count, 1).End(xlUp).Row
If lrow = 1 Then Exit Sub

col_count = sh.Cells(1, Columns.Count).End(xlToLeft).Column

ReDim result(1 To Application.Sum(Range("i1:I" & lrow)), 1 To col_count)

data = sh.Range("a1", sh.Cells(lrow, UBound(result, 2)))

date_col = sh.Rows(1).Find("date", , xlValues, xlWhole).Column
amount_col = sh.Rows(1).Find("amount", , xlValues, xlWhole).Column

For i = 2 To lrow
    temp = data(i, 10)
         
    hours_pd = data(i, 9) / Abs(temp) 'negative to absolute value'
    amount = data(i, amount_col) / Abs(temp) 'negative to absolute value'
    idate = DateSerial(Left(data(i, date_col), 4), Mid(data(i, date_col), 5, 2), Right(data(i, date_col), 2))
    
    For m = 1 To Abs(temp) 'negative to absolute value'
            
        j = j + 1
        
        For n = 1 To 8
            
            result(j, n) = data(i, n)
            
        Next
        
        result(j, 9) = hours_pd
        If temp < 0 Then result(j, 10) = -1 Else result(j, 10) = 1 'days'
        
        For n = 11 To amount_col - 2
        
            result(j, n) = data(i, n)
        
        Next
        
        result(j, date_col) = idate
        result(j, amount_col) = amount
        
        For n = amount_col + 1 To col_count
        
            result(j, n) = data(i, n)
        
        Next
        
        idate = DateAdd("d", 1, idate)
        
    Next

Next

Application.ScreenUpdating = 0

sh.Range("a1", sh.Cells(1, col_count)).Copy Sheets.Add.Range("a1")

With ActiveSheet
    .Range("a2").Resize(j, col_count) = result
    .Range(.Cells(2, amount_col - 5), .Cells(j + 1, amount_col - 2)).NumberFormat = "###.00"
    .Range(.Cells(2, amount_col), .Cells(j + 1, amount_col)).NumberFormat = "#######.00"
    .Cells(1, amount_col - 1).EntireColumn.AutoFit
End With

Application.ScreenUpdating = 1

End Sub

Thanks for providing the solution.