Project plan does not take working days into account when adding offset

[KeBr]

I have a project plan that is largely working well. Now I have added an offset in column "D".
However, the placed Shapes will not last as long as there is a weekend in between. the value of column "D" is added to the value of column "E".

I also added a bit of conditional formatting to highlight the deviations, which works well.

it concerns the part of the macro below:

Next
'get equal date cells
LftCell = Cells(r, 5) + Cells(r, 4) - Cells(6, 5) + 11
RtCell = Cells(r, 6) - Cells(6, 5) + 11


x = Application.Match(Cells(r, 3), Sheets("Gegevens").Columns(5), 0)
If IsNumeric(x) Then fc = RGB(Sheets("Gegevens").Cells(x, 6), Sheets("Gegevens").Cells(x, 7), Sheets("Gegevens").Cells(x, 8))

Select Case Cells(r, 7).Value

Case Is <= 0
'diamond for Milestone date
Set NewShp = ActiveSheet.Shapes.AddShape(msoShapeDiamond, Cells(r, LftCell).Left, Cells(r, LftCell).Top + 2, Cells(r, LftCell).Width, Cells(r, LftCell).Height - 4)
NewShp.Fill.ForeColor.RGB = fc
NewShp.Line.ForeColor.RGB = fc

Case Else

'Get date ranges
Set DtRng = Range(Cells(r, LftCell), Cells(r, RtCell))
LftCell = Cells(r, 5) + Cells(r, 4) + 1 - Cells(6, 5) + 8
RtCell = Cells(r, 6) + 1 - Cells(r, 5) + 12

'if "fase" in C then add a rectangle
If Cells(r, 3) = "fase" Or Cells(r, 3) = "project" Then
Set NewShp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, DtRng.Left + 1, DtRng.Top + 2, DtRng.Width - 10, DtRng.Height - 10)
NewShp.Fill.ForeColor.RGB = fc
NewShp.Line.ForeColor.RGB = fc 'FormulaLocal = "VERT.ZOEKEN(range(C12:C50);Blad3!E3:I28;5;onwaar)"
Set DtRng = Range(Cells(r, LftCell), Cells(r, RtCell))
LftCell = Cells(r, 5) + Cells(r, 4) + 1 - Cells(6, 5) + 10
RtCell = Cells(r, 5) + Cells(r, 4) + 1 - Cells(r, 5) + 12
Set NewShp = ActiveSheet.Shapes.AddShape(msoShapeFlowchartMerge, Cells(r, LftCell).Left + 1, Cells(r, LftCell).Top + 2, Cells(r, LftCell).Width - 5, Cells(r, LftCell).Height - 4)
NewShp.Fill.ForeColor.RGB = fc
NewShp.Line.ForeColor.RGB = fc
Set DtRng = Range(Cells(r, LftCell), Cells(r, RtCell))
LftCell = Cells(r, 6) - Cells(6, 5) + 11
RtCell = Cells(r, 5) + Cells(r, 4) + 1 - Cells(r, 5) + 12
Set NewShp = ActiveSheet.Shapes.AddShape(msoShapeFlowchartMerge, Cells(r, LftCell).Left + 4, Cells(r, LftCell).Top + 2, Cells(r, LftCell).Width - 5, Cells(r, LftCell).Height - 4)
NewShp.Fill.ForeColor.RGB = fc
NewShp.Line.ForeColor.RGB = fc