impegni produzione officina

Option Explicit

Sub Planing_Impegni()
On Error GoTo 10
Application.ScreenUpdating = False
Dim Ncl As Long, Cmm As Long, DtX As Long
Dim k As Long, x As Long, y As Long, z As Long
Dim Rtd As Byte, CMP As Byte
Dim PDt As Integer, DtF As Integer
Dim DCM As Date, ggCM As Byte
Dim DAS As Date, ggAs As Byte
Dim DSA As Date, ggSa As Byte

    Sheets("Commessa").Select
With Worksheets("Planing")
    Ncl = Cells(2, Columns.Count).End(xlToLeft).Column
        Cmm = .Range("A" & .Rows.Count).End(xlUp).Row
        DtX = .Cells(2, .Columns.Count).End(xlToLeft).Column
    Range(.Cells(2, 8), .Cells(Cmm, DtX)).Interior.Pattern = xlNone

    For k = 3 To Cmm
        Cells(3, 1).Value = .Cells(k, 1).Value
            For PDt = 10 To Ncl
                If Cells(4, PDt).Value <> "" Then Exit For
            Next PDt
            
            For DtF = Ncl To 10 Step -1
                If Cells(4, DtF).Value <> "" Then Exit For
            Next DtF
                DCM = Cells(2, PDt).Value
                    ggCM = DtF - PDt
            For PDt = 10 To Ncl
                If Cells(5, PDt).Value <> "" Then Exit For
            Next PDt
            
            For DtF = Ncl To 10 Step -1
                If Cells(5, DtF).Value <> "" Then Exit For
            Next DtF
                DAS = Cells(2, PDt).Value
                    ggAs = DtF - PDt
            For PDt = 10 To Ncl
                If Cells(6, PDt).Value <> "" Then Exit For
            Next PDt
            For DtF = Ncl To 10 Step -1
                If Cells(6, DtF).Value <> "" Then Exit For
            Next DtF
                DSA = Cells(2, PDt).Value
                    ggSa = DtF - PDt
            Rtd = Cells(3, 7).Value
    For x = 2 To Cmm
        If .Cells(x, 1).Value = Cells(3, 1).Value Then Exit For
    Next x
        For y = 8 To DtX
            If .Cells(2, y).Value = Cells(3, 2).Value Then Exit For
        Next y
            For z = 8 To DtX
                If .Cells(2, z).Value = Cells(3, 3).Value Then Exit For
            Next z
        Range(.Cells(k, y), .Cells(k, z)).Interior.ThemeColor = xlThemeColorAccent1
        Range(.Cells(k, y), .Cells(k, z)).Interior.TintAndShade = 0.799981688894314
        If Rtd <> 0 Then Range(.Cells(k, z + 1), .Cells(k, z + Rtd)).Interior.Color = 255

    Range(.Cells(k, DCM - .Cells(2, 8).Value + 8), .Cells(k, DCM - .Cells(2, 8).Value + 8 + ggCM)).Interior.Color = 65535
    Range(.Cells(k, DAS - .Cells(2, 8).Value + 8), .Cells(k, DAS - .Cells(2, 8).Value + 8 + ggAs)).Interior.Color = 15773696
    Range(.Cells(k, DSA - .Cells(2, 8).Value + 8), .Cells(k, DSA - .Cells(2, 8).Value + 8 + ggSa)).Interior.Color = 5296274
    Next k
        Cells(3, 1).Value = .Cells(3, 1).Value
            Cells(8, 10).Select
        .Select
End With
Application.ScreenUpdating = True
    Cells(3, 8).Select
        End
10:
    MsgBox "Dati incongruenti nella Commessa " & Cells(3, 1).Value & Chr(10) & "n.d.r  Ritardo consegna minimo 8 gg."
Application.ScreenUpdating = True
    Cells(8, 10).Select
End Sub

        Range(.Cells(k, y), .Cells(k, z)).Interior.ThemeColor = xlThemeColorAccent1
        Range(.Cells(k, y), .Cells(k, z)).Interior.TintAndShade = 0.799981688894314