Option Explicit
Option Compare Text

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim tbl As ListObject
    Dim splitVal As Long
    Dim colName As String
    Dim keyCells As Range, cel As Range, qtySplitRng As Range, chngReasonRng As Range
    Dim blckdRng As Range, dateRng As Range, openPOCheck As Range, qtyShippedRng As Range
    Dim dict As Object
    Dim dontSplit As Boolean: dontSplit = True
    Dim wb As Workbook, ws As Worksheet
    Dim totShipped As Long, openQty As Long

    On Error GoTo ErrorHandler

    'PW
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Open Orders")
    Set dict = CreateObject("Scripting.Dictionary")
    Set tbl = ws.ListObjects(1)
    Set qtySplitRng = tbl.ListColumns("Qty of shipments").Range
    Set chngReasonRng = Union(tbl.ListColumns("Other Reason for Change").Range, tbl.ListColumns("Other Reason for Delay (Prod Lot)").Range, tbl.ListColumns("Other Reason for Delay (Lab dip)").Range)
    Set blckdRng = Union(Range("LateDaysRange"), Range("ETARange"), Range("LeadTimeRange"), Range("QueryRange"), tbl.ListColumns("COMMENTS").Range, tbl.ListColumns("CHECK").Range)
    Set dateRng = Union(tbl.ListColumns("Submit date").Range, tbl.ListColumns("Submit prod lot date").Range, tbl.ListColumns("Work in progress").Range, tbl.ListColumns("PO Dlvry Date").Range, tbl.ListColumns("NEW PO Dlvry Date").Range)
    Set qtyShippedRng = tbl.ListColumns("Real QTY shipped").DataBodyRange

    dict.Add "Other Reason for Change", "PO Delivery Date"
    dict.Add "Other Reason for Delay (Prod Lot)", "Prod Lot Date"
    dict.Add "Other Reason for Detail (Lab Dip)", "Lab Dip Date"

    If Intersect(Target, qtySplitRng) Is Nothing Then
        If Intersect(Target, qtyShippedRng) Is Nothing Then
            If Intersect(Target, chngReasonRng) Is Nothing Then
                If Intersect(Target, blckdRng) Is Nothing Then
                    If Intersect(Target, dateRng) Is Nothing Then
                        Exit Sub
                    Else
                        WBFast
                        Call DateCheck(Target)
                        GoTo ExitHandler
                    End If
                Else
                    WBFast
                    Application.Undo
                    MsgBox "You tried to edit a blocked range.", vbInformation, "Blocked Range"
                    GoTo ExitHandler
                End If
            Else
                WBFast
                For Each cel In Target.Cells
                    Set keyCells = cel.Offset(, -1)
                    colName = Cells(1, cel.Column)
                    Select Case keyCells.Value2
                        Case "Other"

                        Case Else
                            cel.ClearContents
                            MsgBox "You tried to edit a blocked range." & vbNewLine & "Choose a reason for changing " & dict.Item(colName) & " from the dropdown list in " & keyCells.Address & ". If the reason is not there, choose OTHER and then write down your reason here.", vbInformation, "Blocked Range"
                            GoTo ExitHandler
                    End Select
                Next cel
                GoTo ExitHandler
            End If
        Else
            WBFast
            totShipped = Application.WorksheetFunction.SumIf(tbl.ListColumns("PO/LINE").DataBodyRange, Target.Offset(0, -42).Value2, tbl.ListColumns("Real QTY shipped").DataBodyRange)
            openQty = Target.Offset(0, -32).Value2
            totShipped = totShipped - (openQty * 0.15)
            If totShipped > openQty Then
                Target.ClearContents
                MsgBox "You are shipping " & totShipped & " units in total with or without splits out of " & _
                openQty & " requested originally in column R. Revise your information is okay please.", vbOKOnly + vbInformation, "Shipping Excess"
            End If
            GoTo ExitHandler
        End If
    Else
        dontSplit = False
    End If

    If Target.CountLarge > 1 Then GoTo ExitHandler
    If (IsNull(Target.Value) Or IsEmpty(Target.Value) Or dontSplit) Then GoTo ExitHandler

    If IsNumeric(Target.Value) Then
        If Target.Value < 2 Then
            Target.ClearContents
            GoTo ExitHandler
        End If
    Else
        GoTo ExitHandler
    End If

    splitVal = Target.Value2 - 1
    Set keyCells = Intersect(Target.EntireRow, tbl.DataBodyRange)
    Target.ClearContents

    Call InsertRows(splitVal, keyCells, ws)

    On Error GoTo 0

ExitHandler:
    WBNorm
    Exit Sub

ErrorHandler:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Worksheet_Change, line " & Erl & "."
    GoTo ExitHandler
End Sub

   Sub GetDataFromWB()


    Call PW

    Dim fileName As Variant
    Dim oldOPO As Workbook, newOPO As Workbook
    Dim oldOPOTable As ListObject, newOPOTable As ListObject
    Dim rRows As Long
    Dim PO As CPurchaseOrder, dataItems As cItems
    Dim OPOInfo As Collection, countPO As Collection
    Dim itemKey As String
    Dim newWS As Worksheet, oldWS As Worksheet
    Dim wbCount As Long
    Dim i As Long
    Dim keyCells As Range, headerRow As Range
    Dim cel As Range
    Dim arrPO As Variant, arrNewPO As Variant

    Dim POLine As Long, LabDipStatus As Long, LabDipDate As Long, ReasonDelayLapDip As Long, OtherReasonDelayLabDip As Long, SubmitLabDip As Long, TrackingLabDip As Long
    Dim ProdLotStatus As Long, ProdLotDate As Long, ReasonDelayProdLot As Long, OtherReasonDelayProdLot As Long, SubmitProdLot As Long, TrackingProdLot As Long
    Dim ShipFrom As Long, POStatus As Long, WorkProgress As Long, PODeliveryDate As Long, RealQtyShipped As Long
    Dim ShipMode As Long, Container As Long, Invoice As Long, ReasonChange As Long, OtherReasonChange As Long, NewPODeliveryDate As Long, Comments As Long

    Dim StartTime As Double
    Dim MinutesElapsed As String

    'Remember time when macro starts
      StartTime = Timer

    On Error GoTo ErrorHandler

    fileName = Application.GetOpenFilename("Excel files (*.xls*), *.xls*", 1, "Select a OPO Workbook")

    Set newOPO = ThisWorkbook
    Set newWS = newOPO.Worksheets("Open Orders")
    Set newOPOTable = newWS.ListObjects("TableLawsonQuery")
    Set oldOPO = Workbooks.Open(fileName)
    Set oldWS = oldOPO.Worksheets("Open Orders")
    Set oldOPOTable = oldWS.ListObjects("TableLawsonQuery")
    Set headerRow = oldOPOTable.HeaderRowRange

    Set OPOInfo = New Collection
    Set countPO = New Collection

    WBFast


    POLine = Application.WorksheetFunction.Match("PO/Line", headerRow, 0)
    LabDipStatus = Application.WorksheetFunction.Match("Lab dip status", headerRow, 0)
    LabDipDate = Application.WorksheetFunction.Match("Submit date", headerRow, 0)
    ReasonDelayLapDip = Application.WorksheetFunction.Match("Reason for delay (Lab dip)", headerRow, 0)
    OtherReasonDelayLabDip = Application.WorksheetFunction.Match("Other Reason for Delay (Lab dip)", headerRow, 0)
    SubmitLabDip = Application.WorksheetFunction.Match("# Submit Lab Dip", headerRow, 0)
    TrackingLabDip = Application.WorksheetFunction.Match("Tracking Lab Dip", headerRow, 0)
    ProdLotStatus = Application.WorksheetFunction.Match("Prod Lot Status", headerRow, 0)
    ProdLotDate = Application.WorksheetFunction.Match("Submit prod lot date", headerRow, 0)
    ReasonDelayProdLot = Application.WorksheetFunction.Match("Reason for delay (Prod Lot)", headerRow, 0)
    OtherReasonDelayProdLot = Application.WorksheetFunction.Match("Other Reason for Delay (Prod Lot)", headerRow, 0)
    SubmitProdLot = Application.WorksheetFunction.Match("# Submit Prod Lot", headerRow, 0)
    TrackingProdLot = Application.WorksheetFunction.Match("Tracking Prod Lot", headerRow, 0)
    ShipFrom = Application.WorksheetFunction.Match("Ship from", headerRow, 0)
    POStatus = Application.WorksheetFunction.Match("PO Status", headerRow, 0)
    WorkProgress = Application.WorksheetFunction.Match("Work in progress", headerRow, 0)
    PODeliveryDate = Application.WorksheetFunction.Match("PO Dlvry Date", headerRow, 0)
    RealQtyShipped = Application.WorksheetFunction.Match("Real QTY shipped", headerRow, 0)
    ShipMode = Application.WorksheetFunction.Match("SHIPMODE", headerRow, 0)
    Container = Application.WorksheetFunction.Match("ASAP, AWB # or Container #", headerRow, 0)
    Invoice = Application.WorksheetFunction.Match("INVOICE #", headerRow, 0)
    ReasonChange = Application.WorksheetFunction.Match("REASON FOR CHANGE", headerRow, 0)
    OtherReasonChange = Application.WorksheetFunction.Match("Other Reason for Change", headerRow, 0)
    NewPODeliveryDate = Application.WorksheetFunction.Match("NEW PO Dlvry Date", headerRow, 0)
    Comments = Application.WorksheetFunction.Match("COMMENTS", headerRow, 0)

    arrPO = oldOPOTable.DataBodyRange.Value2
    oldOPO.Close False

    For rRows = 1 To UBound(arrPO)
        If Len(arrPO(1, 64)) > 11 Then
            'Counts duplicate values in old OPO
            itemKey = CStr(arrPO(rRows, POLine))

            Set dataItems = Nothing: On Error Resume Next
            Set dataItems = countPO(itemKey): On Error GoTo 0

            If dataItems Is Nothing Then
                Set dataItems = New cItems
                dataItems.Key = itemKey
                countPO.Add dataItems, itemKey
            End If

            With dataItems
                .Count = .Count + 1
            End With


            '------OLD OPO INFO------'
            On Error Resume Next
            Set PO = New CPurchaseOrder
            PO.POLine = arrPO(rRows, POLine)

            PO.LabDipStatus = arrPO(rRows, LabDipStatus)
            PO.LabDipDate = arrPO(rRows, LabDipDate)
            PO.ReasonDelayLapDip = arrPO(rRows, ReasonDelayLapDip)
            PO.OtherReasonDelayLabDip = arrPO(rRows, OtherReasonDelayLabDip)
            PO.SubmitLabDip = arrPO(rRows, SubmitLabDip)
            PO.TrackingLabDip = arrPO(rRows, TrackingLabDip)

            PO.ProdLotStatus = arrPO(rRows, ProdLotStatus)
            PO.ProdLotDate = arrPO(rRows, ProdLotDate)
            PO.ReasonDelayProdLot = arrPO(rRows, ReasonDelayProdLot)
            PO.OtherReasonDelayProdLot = arrPO(rRows, OtherReasonDelayProdLot)
            PO.SubmitProdLot = arrPO(rRows, SubmitProdLot)
            PO.TrackingProdLot = arrPO(1, TrackingProdLot)

            PO.ShipFrom = arrPO(rRows, ShipFrom)
            PO.POrderStatus = arrPO(rRows, POStatus)
            PO.WorkProgress = arrPO(rRows, WorkProgress)
            PO.PODeliveryDate = arrPO(rRows, PODeliveryDate)
            PO.RealQtyShipped = arrPO(rRows, RealQtyShipped)
            PO.ShipMode = arrPO(rRows, ShipMode)
            PO.Container = arrPO(rRows, Container)
            PO.Invoice = arrPO(rRows, Invoice)
            PO.ReasonChange = arrPO(rRows, ReasonChange)
            PO.OtherReasonChange = arrPO(rRows, OtherReasonChange)
            PO.NewPODeliveryDate = arrPO(rRows, NewPODeliveryDate)

            OPOInfo.Add PO
        End If
    Next rRows

    For Each cel In newOPOTable.ListColumns("PO/LINE").DataBodyRange
        itemKey = CStr(cel.Value2)
        Set dataItems = Nothing: On Error Resume Next
        Set dataItems = countPO(itemKey): On Error GoTo 0

        If dataItems Is Nothing Then

        Else
            If dataItems.Count > 1 Then
                Set keyCells = Intersect(cel.EntireRow, newOPOTable.DataBodyRange)
                Call InsertRows(dataItems.Count - 1, keyCells, newWS)
                countPO.Remove itemKey
            End If
        End If
    Next cel

    'Deletes validations because they mess everything up
    newWS.Cells.Validation.Delete

    Set headerRow = Nothing
    Set headerRow = newOPOTable.HeaderRowRange

    POLine = Application.WorksheetFunction.Match("PO/Line", headerRow, 0)
    LabDipStatus = Application.WorksheetFunction.Match("Lab dip status", headerRow, 0)
    LabDipDate = Application.WorksheetFunction.Match("Submit date", headerRow, 0)
    ReasonDelayLapDip = Application.WorksheetFunction.Match("Reason for delay (Lab dip)", headerRow, 0)
    OtherReasonDelayLabDip = Application.WorksheetFunction.Match("Other Reason for Delay (Lab dip)", headerRow, 0)
    SubmitLabDip = Application.WorksheetFunction.Match("# Submit Lab Dip", headerRow, 0)
    TrackingLabDip = Application.WorksheetFunction.Match("Tracking Lab Dip", headerRow, 0)
    ProdLotStatus = Application.WorksheetFunction.Match("Prod Lot Status", headerRow, 0)
    ProdLotDate = Application.WorksheetFunction.Match("Submit prod lot date", headerRow, 0)
    ReasonDelayProdLot = Application.WorksheetFunction.Match("Reason for delay (Prod Lot)", headerRow, 0)
    OtherReasonDelayProdLot = Application.WorksheetFunction.Match("Other Reason for Delay (Prod Lot)", headerRow, 0)
    SubmitProdLot = Application.WorksheetFunction.Match("# Submit Prod Lot", headerRow, 0)
    TrackingProdLot = Application.WorksheetFunction.Match("Tracking Prod Lot", headerRow, 0)
    ShipFrom = Application.WorksheetFunction.Match("Ship from", headerRow, 0)
    POStatus = Application.WorksheetFunction.Match("PO Status", headerRow, 0)
    WorkProgress = Application.WorksheetFunction.Match("Work in progress", headerRow, 0)
    PODeliveryDate = Application.WorksheetFunction.Match("PO Dlvry Date", headerRow, 0)
    RealQtyShipped = Application.WorksheetFunction.Match("Real QTY shipped", headerRow, 0)
    ShipMode = Application.WorksheetFunction.Match("SHIPMODE", headerRow, 0)
    Container = Application.WorksheetFunction.Match("ASAP, AWB # or Container #", headerRow, 0)
    Invoice = Application.WorksheetFunction.Match("INVOICE #", headerRow, 0)
    ReasonChange = Application.WorksheetFunction.Match("REASON FOR CHANGE", headerRow, 0)
    OtherReasonChange = Application.WorksheetFunction.Match("Other Reason for Change", headerRow, 0)
    NewPODeliveryDate = Application.WorksheetFunction.Match("NEW PO Dlvry Date", headerRow, 0)
    Comments = Application.WorksheetFunction.Match("COMMENTS", headerRow, 0)

    arrNewPOs = newOPOTable.ListColumns(8).Range.Value2

    For rRows = 2 To UBound(arrNewPOs)
        For i = OPOInfo.Count To 1 Step -1
            Set PO = OPOInfo(i)
            If arrNewPOs(rRows, 1) = PO.POLine Then
                newWS.Cells(rRows, LabDipStatus) = PO.LabDipStatus
                newWS.Cells(rRows, LabDipDate) = PO.LabDipDate
                newWS.Cells(rRows, ReasonDelayLapDip) = PO.ReasonDelayLapDip
                newWS.Cells(rRows, OtherReasonDelayLabDip) = PO.OtherReasonDelayLabDip
                newWS.Cells(rRows, SubmitLabDip) = PO.SubmitLabDip
                newWS.Cells(rRows, TrackingLabDip) = PO.TrackingLabDip

                newWS.Cells(rRows, ProdLotStatus) = PO.ProdLotStatus
                newWS.Cells(rRows, ProdLotDate) = PO.ProdLotDate
                newWS.Cells(rRows, ReasonDelayProdLot) = PO.ReasonDelayProdLot
                newWS.Cells(rRows, OtherReasonDelayProdLot) = PO.OtherReasonDelayProdLot
                newWS.Cells(rRows, SubmitProdLot) = PO.SubmitProdLot
                newWS.Cells(rRows, TrackingProdLot) = PO.TrackingProdLot

                newWS.Cells(rRows, ShipFrom) = PO.ShipFrom
                newWS.Cells(rRows, POStatus) = PO.POrderStatus
                newWS.Cells(rRows, WorkProgress) = PO.WorkProgress
                newWS.Cells(rRows, PODeliveryDate) = PO.PODeliveryDate
                newWS.Cells(rRows, RealQtyShipped) = PO.RealQtyShipped
                newWS.Cells(rRows, ShipMode) = PO.ShipMode
                newWS.Cells(rRows, Container) = PO.Container
                newWS.Cells(rRows, Invoice) = PO.Invoice
                newWS.Cells(rRows, ReasonChange) = PO.ReasonChange
                newWS.Cells(rRows, OtherReasonChange) = PO.OtherReasonChange
                newWS.Cells(rRows, NewPODeliveryDate) = PO.NewPODeliveryDate

                OPOInfo.Remove i
                Exit For
            End If
        Next i
    Next rRows

    Set keyCells = newOPOTable.ListColumns("Lab dip status").DataBodyRange
    Call DoValidation("Wrong value", 3, "=INDIRECT(""TableLabProdStatus[LabProdStatus]"")", keyCells, "Choose a value from drop down list")

    Set keyCells = newOPOTable.ListColumns("Prod Lot Status").DataBodyRange
    Call DoValidation("Wrong value", 3, "=INDIRECT(""TableLabProdStatus[LabProdStatus]"")", keyCells, "Choose a value from drop down list")

    Set keyCells = newOPOTable.ListColumns("Reason for delay (Lab dip)").DataBodyRange
    Call DoValidation("Wrong value", 3, "=INDIRECT(""TableLabDipReasons[LabDipReasons]"")", keyCells, "Choose a value from drop down list")

    Set keyCells = newOPOTable.ListColumns("Reason for delay (Prod Lot)").DataBodyRange
    Call DoValidation("Wrong value", 3, "=INDIRECT(""TableProdLotReasons[ProdLotReasons]"")", keyCells, "Choose a value from drop down list")

    Set keyCells = newOPOTable.ListColumns("PO Status").DataBodyRange
    Call DoValidation("Wrong value", 3, "=INDIRECT(""TablePOStatus[POStatus]"")", keyCells, "Choose a value from drop down list")

    Set keyCells = newOPOTable.ListColumns("Ship from").DataBodyRange
    Call DoValidation("Wrong value", 3, "=INDIRECT(""TableShipFrom[ShipFrom]"")", keyCells, "Choose a value from drop down list")


    Set keyCells = newOPOTable.ListColumns("SHIPMODE").DataBodyRange
    Call DoValidation("Wrong value", 3, "=INDIRECT(""TableShipMode[ShipMode]"")", keyCells, "Choose a value from drop down list")

    Set keyCells = newOPOTable.ListColumns("REASON FOR CHANGE").DataBodyRange
    Call DoValidation("Wrong value", 3, "=INDIRECT(""TableReasonChange[ReasonChange]"")", keyCells, "Choose a value from drop down list")

    'Determine how many seconds code took to run
    MinutesElapsed = format((Timer - StartTime) / 86400, "hh:mm:ss")

    'Notify user in seconds
    MsgBox "This code ran successfully in " & MinutesElapsed & " seconds.", vbInformation, "Imported Data Successfully"

ExitHandler:
        WBNorm
        Exit Sub

ErrorHandler:
        Select Case Err.Number
            Case 9
                MsgBox "Column, sheet or table not found. Check names in file have not changed and try again." & vbNewLine & _
                "Get_Data module |" & Err.Number & ": " & Err.Description & ".", vbInformation, "Not found"
            Case Else
                MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Worksheet_Change, line " & Erl & "."
        GoTo ExitHandler
    End Sub

Private pPOLine As String
Private pLabDipStatus As String
Private pLabDipDate As String
Private pReasonDelayLapDip As String
Private pOtherReasonDelayLabDip As String
Private pSubmitLabDip As String
Private pTrackingLabDip As String
Private pProdLotStatus As String
Private pProdLotDate As String
Private pReasonDelayProdLot As String
Private pOtherReasonDelayProdLot As String
Private pSubmitProdLot As String
Private pTrackingProdLot As String
Private pShipFrom As String
Private pOrderShipment As String
Private pPOrderStatus As String
Private pWorkProgress As String
Private pPODeliveryDate As String
Private pRealQtyShipped As Long
Private pShipMode As String
Private pContainer As String
Private pInvoice As String
Private pReasonChange As String
Private pOtherReasonChange As String
Private pNewPODeliveryDate As String
Private pComments As String

Public Property Get POLine() As String
     POLine = pPOLine
End Property
Public Property Let POLine(Value As String)
    pPOLine = Value
End Property
'---------------LAB DIP-------------------
'-----------------------------------------
Public Property Get LabDipStatus() As String
     LabDipStatus = pLabDipStatus
End Property
Public Property Let LabDipStatus(Value As String)
    pLabDipStatus = Value
End Property
Public Property Get LabDipDate() As String
     LabDipDate = pLabDipDate
End Property
Public Property Let LabDipDate(Value As String)
    pLabDipDate = Value
End Property
Public Property Get ReasonDelayLapDip() As String
     ReasonDelayLapDip = pReasonDelayLapDip
End Property
Public Property Let ReasonDelayLapDip(Value As String)
    pReasonDelayLapDip = Value
End Property
Public Property Get OtherReasonDelayLabDip() As String
     OtherReasonDelayLabDip = pOtherReasonDelayLabDip
End Property
Public Property Let OtherReasonDelayLabDip(Value As String)
    pOtherReasonDelayLabDip = Value
End Property
Public Property Get SubmitLabDip() As String
     SubmitLabDip = pSubmitLabDip
End Property
Public Property Let SubmitLabDip(Value As String)
    pSubmitLabDip = Value
End Property
Public Property Get TrackingLabDip() As String
     TrackingLabDip = pTrackingLabDip
End Property
Public Property Let TrackingLabDip(Value As String)
    pTrackingLabDip = Value
End Property
'---------------PROD LOT------------------
'-----------------------------------------
Public Property Get ProdLotStatus() As String
     ProdLotStatus = pProdLotStatus
End Property
Public Property Let ProdLotStatus(Value As String)
    pProdLotStatus = Value
End Property
Public Property Get ProdLotDate() As String
     ProdLotDate = pProdLotDate
End Property
Public Property Let ProdLotDate(Value As String)
    pProdLotDate = Value
End Property
Public Property Get ReasonDelayProdLot() As String
     ReasonDelayProdLot = pReasonDelayProdLot
End Property
Public Property Let ReasonDelayProdLot(Value As String)
    pReasonDelayProdLot = Value
End Property
Public Property Get OtherReasonDelayProdLot() As String
     OtherReasonDelayProdLot = pOtherReasonDelayProdLot
End Property
Public Property Let OtherReasonDelayProdLot(Value As String)
    pOtherReasonDelayProdLot = Value
End Property
Public Property Get SubmitProdLot() As String
     SubmitProdLot = pSubmitProdLot
End Property
Public Property Let SubmitProdLot(Value As String)
    pSubmitProdLot = Value
End Property
Public Property Get TrackingProdLot() As String
     TrackingProdLot = pTrackingProdLot
End Property
Public Property Let TrackingProdLot(Value As String)
    pTrackingProdLot = Value
End Property
'---------------PO STATUS-----------------
'-----------------------------------------
Public Property Get ShipFrom() As String
     ShipFrom = pShipFrom
End Property
Public Property Let ShipFrom(Value As String)
    pShipFrom = Value
End Property
Public Property Get OrderShipment() As String
     OrderShipment = pOrderShipment
End Property
Public Property Let OrderShipment(Value As String)
    pOrderShipment = Value
End Property
Public Property Get POrderStatus() As String
     POrderStatus = pPOrderStatus
End Property
Public Property Let POrderStatus(Value As String)
    If Value = "Shipping" Then Value = "In Progress"
    pPOrderStatus = Value
End Property
Public Property Get WorkProgress() As String
     WorkProgress = pWorkProgress
End Property
Public Property Let WorkProgress(Value As String)
    pWorkProgress = Value
End Property
Public Property Get PODeliveryDate() As String
     PODeliveryDate = pPODeliveryDate
End Property
Public Property Let PODeliveryDate(Value As String)
    pPODeliveryDate = Value
End Property
Public Property Get RealQtyShipped() As Long
     RealQtyShipped = pRealQtyShipped
End Property
Public Property Let RealQtyShipped(Value As Long)
    pRealQtyShipped = Value
End Property
Public Property Get ShipMode() As String
     ShipMode = pShipMode
End Property
Public Property Let ShipMode(Value As String)
    Select Case Value
        Case "By Air (any carrier)"
            Value = "Air (any carrier)"
        Case "By Land"
            Value = "Land"
        Case "By Sea"
            Value = "Sea"
        Case "By ASAP"
            Value = "Expediting (ASAP)"
        Case Else

    End Select
    pShipMode = Value
End Property
Public Property Get Container() As String
     Container = pContainer
End Property
Public Property Let Container(Value As String)
    pContainer = Value
End Property
Public Property Get Invoice() As String
     Invoice = pInvoice
End Property
Public Property Let Invoice(Value As String)
    pInvoice = Value
End Property
'---------------DLVRY CHANGE--------------
'-----------------------------------------
Public Property Get ReasonChange() As String
     ReasonChange = pReasonChange
End Property
Public Property Let ReasonChange(Value As String)
    pReasonChange = Value
End Property
Public Property Get OtherReasonChange() As String
     OtherReasonChange = pOtherReasonChange
End Property
Public Property Let OtherReasonChange(Value As String)
    pOtherReasonChange = Value
End Property
Public Property Get NewPODeliveryDate() As String
     NewPODeliveryDate = pNewPODeliveryDate
End Property
Public Property Let NewPODeliveryDate(Value As String)
    pNewPODeliveryDate = Value
End Property

Public Property Get Comments() As String
     Comments = pComments
End Property
Public Property Let Comments(Value As String)
    If Err.Number <> 0 Then Resume Next
    pComments = Value
End Property

Public Key As String
Public Count As Long
Public ItemList As Collection

Private Sub Class_Initialize()
    Count = 0
    Set ItemList = New Collection
End Sub

Sub InsertRows(ByVal splitVal As Integer, ByVal keyCells As Range, ws As Worksheet)

    PW
    WBFast
    With keyCells
        .Offset(1).Resize(splitVal).EntireRow.Insert
        .EntireRow.Copy .Offset(1, 0).Resize(splitVal).EntireRow
    End With

End Sub

Public Sub DoValidation(errorTitle As String, valType As Long, valForm As String, rng As Range, errorMsg As String)

With rng.Validation
        .Delete
        .Add Type:=valType, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=valForm
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .errorTitle = errorTitle
        .InputMessage = ""
        .ErrorMessage = errorMsg
        .ShowInput = True
        .ShowError = True
End With

End Sub

Sub WBFast()
    With ThisWorkbook.Application
        .EnableEvents = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

End Sub

Sub WBNorm()
    With ThisWorkbook.Application
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim tbl As ListObject
    Dim checkCol As Range
    Dim res As Integer
    Dim wb As Workbook

    Set checkCol = Range("TableLawsonQuery[CHECK]")

    res = Application.WorksheetFunction.CountIfs(checkCol, "<>In progress", checkCol, "<>RIGHT")

    If res > 0 Then
        Select Case MsgBox("There are " & res & " PO(s) with ambiguous information. They are highlighted in red. For more detail as to what is wrong, " & _
        "check the column " & Chr(34) & "BM" & Chr(34) & " in Open Orders sheet." & _
        vbNewLine & "Check your information please.", vbInformation + vbYesNo + vbDefaultButton1, "OPO Check")

        Case vbYes
            Cancel = True
        End Select
    End If

End Sub

Private Sub Workbook_Open()
    Dim tblLawson As ListObject, tblControl As ListObject
    Dim checkCol As Range
    Dim res As Integer
    Dim wb As Workbook
    Dim ans As String


    Set wb = ThisWorkbook
    Set tblLawson = wb.Worksheets("Open Orders").ListObjects("TableLawsonQuery")
    Set tblControl = wb.Worksheets("Vendor").ListObjects("TableControl")
    Set checkCol = tblLawson.ListColumns("CHECK").DataBodyRange

    On Error Resume Next
    res = Application.WorksheetFunction.CountIfs(checkCol, "<>In progress", checkCol, "<>RIGHT")

    If res > 0 Then
        MsgBox "There are " & res & " PO(s) with ambiguous information. They are highlighted in red. For more detail as to what is wrong, check the column " & Chr(34) & "BM" & Chr(34) & " in Open Orders sheet", vbInformation, "OPO Check"
        On Error Resume Next
        wb.Worksheets("Open Orders").Activate
        tblLawson.ListColumns("CHECK").DataBodyRange.Select
    Else
        On Error Resume Next
        ans = wb.Application.WorksheetFunction.Index(tblControl.ListColumns("ACTIVATE").DataBodyRange, Application.WorksheetFunction.Match("GUIDELINE", tblControl.ListColumns("CONTROL").DataBodyRange, 0))
        If ans = "YES" Then wb.Worksheets("Guideline").Activate
    End If

End Sub

Sub FillData()

    Dim tblControl As ListObject, tblLawson As ListObject
    Dim wb As Workbook
    Dim wsVen As Worksheet, wsOPO As Worksheet
    Dim cel As Range


    Set wb = ThisWorkbook
    Set wsVen = wb.Worksheets("Vendor")
    Set wsOPO = wb.Worksheets("Open Orders")

    Set tblControl = wsVen.ListObjects("TableControl")
    Set tblLawson = wsOPO.ListObjects("TableLawsonQuery")

    WBFast
    For Each cel In tblControl.ListColumns("CONTROL").DataBodyRange
        Select Case cel.Value2
            Case "FILL_SHIPMODE"
                If cel.Offset(0, 2).Value2 = "YES" Then tblLawson.ListColumns("SHIPMODE").DataBodyRange.Value2 = cel.Offset(0, 1).Value2
            Case "FILL_SHIPFROM"
                If cel.Offset(0, 2).Value2 = "YES" Then tblLawson.ListColumns("SHIP FROM").DataBodyRange.Value2 = cel.Offset(0, 1).Value2
            Case "REQUESTER"
                If cel.Offset(0, 2).Value2 = "YES" Then Call DeleteFilterCriteria(cel.Offset(0, 1).Value2, tblLawson, 5)
            Case "COMPANY"
                If cel.Offset(0, 2).Value2 = "YES" Then Call DeleteFilterCriteria(cel.Offset(0, 1).Value2, tblLawson, 2)
            Case "COMPLETE"
                If cel.Offset(0, 2).Value2 = "YES" Then Call DeleteFilterCriteria(cel.Offset(0, 1).Value2, tblLawson, 19)
            Case Else

        End Select
    Next cel

    tblLawson.ListColumns("USER").DataBodyRange.Value2 = UserName

    WBNorm

End Sub

Sub DeleteFilterCriteria(xCriteria As String, tblTarget As ListObject, filterColumn As Long)

    'Call PW

    Dim ws As Worksheet
    Dim wb As Workbook
    Dim rngDel As Range, cel As Range
    Dim a As Long

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Open Orders")

    'ws.Unprotect Password
    tblTarget.ShowAutoFilter = False
    tblTarget.ShowAutoFilter = True

    With tblTarget
        .Range.AutoFilter Field:=filterColumn, Criteria1:=xCriteria, Operator:=xlFilterValues
        On Error Resume Next
        Set rngDel = Intersect(.DataBodyRange, .DataBodyRange.SpecialCells(xlCellTypeVisible))
    End With

    If Not rngDel Is Nothing Then
        For a = rngDel.Areas.Count To 1 Step -1
            rngDel.Areas(a).EntireRow.Delete
        Next a
    End If

    tblTarget.ShowAutoFilter = False
    tblTarget.ShowAutoFilter = True

End Sub