Distributing Daily Productions on Calender

[adokskel]

Hello everyone,

Can this problem be solved by only functions or is it needed to write macro?

I want to distribute daily planned production quantities from starting day to deadline.

https://pasteboard.co/GOSLoSn.jpg


Thank you very much

 

[mumps]

Try this macro:

Sub DDP()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim sDate As Range
    Dim foundSDate As Range
    Dim DV1 As Date
    Dim DV2 As Date
    Dim foundEDate As Range
    Dim lColumn As Long
    lColumn = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
    For Each sDate In Range("D3:D" & LastRow)
        DV1 = DateValue(CStr(sDate))
        DV2 = DateValue(CStr(sDate.Offset(0, 1)))
        Set foundSDate = Range(Cells(2, 8), Cells(2, lColumn)).Find(What:=Format(DV1, "dd.mm.yyyy"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
        Set foundEDate = Range(Cells(2, 8), Cells(2, lColumn)).Find(What:=Format(DV2, "dd.mm.yyyy"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
        With Range(Cells(sDate.Row, foundSDate.Column - 1), Cells(sDate.Row, foundEDate.Column - 1))
            .Value = sDate.Offset(0, 3)
            .Interior.ColorIndex = sDate.Interior.ColorIndex
        End With
    Next sDate
    Application.ScreenUpdating = True
End Sub

 

[mumps]

Sorry. I had to make one minor correction. Please use this version of the macro:

Sub DDP()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim sDate As Range
    Dim foundSDate As Range
    Dim DV1 As Date
    Dim DV2 As Date
    Dim foundEDate As Range
    Dim lColumn As Long
    lColumn = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
    For Each sDate In Range("D3:D" & LastRow)
        DV1 = DateValue(CStr(sDate))
        DV2 = DateValue(CStr(sDate.Offset(0, 1)))
        Set foundSDate = Range(Cells(2, 8), Cells(2, lColumn)).Find(What:=Format(DV1, "dd.mm.yyyy"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
        Set foundEDate = Range(Cells(2, 8), Cells(2, lColumn)).Find(What:=Format(DV2, "dd.mm.yyyy"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
        With Range(Cells(sDate.Row, foundSDate.Column), Cells(sDate.Row, foundEDate.Column - 1))
            .Value = sDate.Offset(0, 3)
            .Interior.ColorIndex = sDate.Interior.ColorIndex
        End With
    Next sDate
    Application.ScreenUpdating = True
End Sub