VBA to display data loaded into user form on the main sheet.

[TCII]

I have received a workbook that populates data from an SQL database. Once the "Master" worksheet is populated if the user right clicks any row greater or equal to row 3 and column A a more detailed view of the "Job" selected is displayed in a user form. In this form a "Total Actual Hours" column is displayed and populated along with some other information. I would like to have this "Total Actual Hours" value displayed in the "Master" sheet as well to provide a quicker reference for the users. This workbook contains multiple user forms, modules and codes so if I have missed some or additional information is needed please let me know and I will try to have them added.

Private Sub ExportSpecial()
    Dim tmpRS As ADODB.Recordset
    Dim tmpST As String
    
    Dim tmpI As Long
    tmpI = 100
    
    Dim tmpPr As Variant    'Priority
    Dim tmpSD As Variant    'Start Date
    Dim tmpED As Variant    'End Date
    Dim tmpDL As Variant    'Days Late
    Dim tmpWC As Variant    'Work Code
    Dim tmpN As Variant     'Notes
    Dim tmpAH As Variant    'Actual Hours           ADDED BY: TCII
    
    tmpST = txtSpecial
    
'    objM.Range("AV4").Value = tmpST
    
    Set tmpRS = ExecSQL(tmpST)
    If tmpRS.RecordCount > 0 Then
        While Not tmpRS.EOF
            objM.Range(Column("JobNo", objM) & intR).Value = Trim(tmpRS("JobNo").Value)
            
            tmpPr = ImportPriority(tmpRS("Priority").Value)
            objM.Range(Column("Priority", objM) & intR).Value = tmpPr
            
            objM.Range(Column("PONum", objM) & intR).Value = Trim(tmpRS("PONum").Value)
            objM.Range(Column("CustCode", objM) & intR).Value = Trim(tmpRS("CustCode").Value)
            objM.Range(Column("PartNo", objM) & intR).Value = UCase(Trim(tmpRS("PartNo").Value))
            objM.Range(Column("PartDesc", objM) & intR).Value = UCase(Replace(Trim(tmpRS("PartDesc").Value), vbLf, ""))
            objM.Range(Column("ProdCode", objM) & intR).Value = Trim(tmpRS("ProdCode").Value)
            
            objM.Range(Column("Type", objM) & intR).Value = CalcType(tmpRS)
            
            If Not IsNull(tmpRS("OrderDate").Value) Then objM.Range(Column("OrderDate", objM) & intR).Value = tmpRS("OrderDate").Value
            
            objM.Range(Column("Jobs", objM) & intR).Value = tmpRS("Jobs").Value
            objM.Range(Column("Qty", objM) & intR).Value = tmpRS("Qty").Value
            objM.Range(Column("SetupTime", objM) & intR).Value = tmpRS("SetupTime").Value
            objM.Range(Column("SetupUnit", objM) & intR).Value = Trim(tmpRS("SetupUnit").Value)
            
            If VerifyDate(tmpRS("StartDate").Value) And VerifyDate(tmpRS("EndDate").Value) Then
                tmpSD = DateValue(tmpRS("StartDate").Value)
                objM.Range(Column("StartDate", objM) & intR).Value = tmpSD
                
                tmpED = DateValue(tmpRS("EndDate").Value)
                objM.Range(Column("EndDate", objM) & intR).Value = tmpED
                
                objM.Range(Column("Days", objM) & intR).Value = CalcWork(tmpSD, tmpED)
                
                tmpDL = CalcWork(tmpSD, Now())
                If tmpDL > 0 Then
                    objM.Range(Column("DaysLate", objM) & intR).Value = tmpDL
                    objM.Range(Column("DaysLate", objM) & intR).Interior.Color = 255
                End If
            Else
                If VerifyDate(tmpRS("StartDate").Value) Then objM.Range(Column("StartDate", objM) & intR).Value = DateValue(tmpRS("StartDate").Value) _
                    Else objM.Range(Column("StartDate", objM) & intR).Value = "ERROR"
                
                If VerifyDate(tmpRS("EndDate").Value) Then objM.Range(Column("EndDate", objM) & intR).Value = DateValue(tmpRS("EndDate").Value) _
                    Else objM.Range(Column("EndDate", objM) & intR).Value = "ERROR"
                
                objM.Range(Column("Days", objM) & intR).Value = "ERROR"
                
                intE = intE + 1
            End If
            
            tmpWC = tmpRS("WorkCode").Value
            
            If Not IsNull(tmpRS("ONotes").Value) Then
                tmpN = UCase(Trim(tmpRS("ONotes").Value))
            Else
                tmpN = ""
            End If
            
            If Not IsNull(tmpRS("JNotes").Value) Then
                If tmpN <> "" Then tmpN = tmpN & " / "
                tmpN = UCase(Trim(tmpRS("OpNotes").Value))
            End If
            
            tmpN = Replace(tmpN, "~", "'")
            
            If Not IsNull(tmpRS("Scheduled").Value) Then _
                objM.Range(Column("Schedule", objM) & intR).Value = tmpRS("Scheduled").Value
            
            If Not IsNull(tmpRS("Quality").Value) Then _
                objM.Range(Column("Quality", objM) & intR).Value = tmpRS("Quality").Value
            
            If Not IsNull(tmpRS("Printed").Value) Then _
                objM.Range(Column("Printed", objM) & intR).Value = tmpRS("Printed").Value
            
            If intR > tmpI Then
                Call UpdateStatusBar("PROCESSING - " & tmpI)
                tmpI = tmpI + 100
                
'               Set tmpRS = Nothing
'               Exit Sub
            End If
            
            If tmpWC <> "" And tmpN = "" Then
                tmpN = tmpWC
            ElseIf tmpWC <> "" And tmpN <> "" Then
                tmpN = tmpWC & " // " & tmpN
            End If
            
            objM.Range(Column("Notes", objM) & intR).Value = tmpN
            
            intR = intR + 1
            tmpRS.MoveNext
        Wend
    Else
        MsgBox "No Jobs Found", vbExclamation
        intR = 0
        Set tmpRS = Nothing
        
        Call ProtectSheet(objM)
        Call ProtectSheet(objR)
        
        Application.ScreenUpdating = True
        Application.EnableEvents = True
        Application.StatusBar = False
        
        Exit Sub
    End If
    
    Set tmpRS = Nothing
End Sub

Public Sub SchedDetail(ByVal tmpTarget As Range, ByVal tmpJobName As String, ByVal tmpStepName As String, Optional ByVal tmpPage As Integer = 0)
    Dim tmpJob As String
    Dim tmpStep As String
    
    Set objTarget = tmpTarget
    txtJobName = tmpJobName
    txtStepName = tmpStepName
    
    Set objS = tmpTarget.Worksheet
    intR = tmpTarget.Row
    
    tmpJob = objS.Range(Column(tmpJobName, objS) & intR).Text
    tmpStep = objS.Range(Column(tmpStepName, objS) & intR).Text
    
    If tmpStep = "" Then tmpStep = "00"
    
    Call ConnectSQL
    Call ImportOrder(frmSchedDetail, frmSchedDetail.objOrder, tmpJob)
    Call ImportJob(frmSchedDetail, frmSchedDetail.objJob, tmpJob, tmpStep)
    Call ImportRequired(frmSchedDetail.objRequired, tmpJob)
    Call ImportIssued(frmSchedDetail.objIssued, tmpJob)
    If ImportNC(frmSchedDetail.objNC, tmpJob) > 0 Then frmSchedDetail.mpSchedDetail.Pages(3).Visible = True
    

    Call CloseSQL
    
    If ImportHours(frmSchedDetail.objHours, tmpJob, tmpStep) > 0 Then frmSchedDetail.mpSchedDetail.Pages(6).Visible = True
    'Call ImportWeekMach(frmSchedDetail, frmSchedDetail.objMach, tmpJob, tmpStep)
    Call ImportMachHist(frmSchedDetail.objMach, tmpJob, tmpStep)
    Call ImportJobs(frmSchedDetail.objJobs, tmpJob, tmpStep)
    
    frmSchedDetail.mpSchedDetail.value = tmpPage
    frmSchedDetail.Show
End Sub

Public Function ImportJob(ByVal tmpForm As UserForm, ByVal tmpList As ListView, _
                          ByVal tmpJob As String, Optional ByVal tmpStep As String = "00", _
                          Optional ByRef tmpComp As String = "", _
                          Optional ByRef tmpWork As String = "", _
                          Optional ByRef tmpActual As Date = "1/1/1900", _
                          Optional ByRef tmpScrap As Integer = 0, _
                          Optional ByRef tmpDisp As Integer = 0, _
                          Optional ByRef tmpNotes As String = "") As String
                          
    Dim tmpRS As ADODB.Recordset
    Dim tmpR As Integer
    Dim tmpSt As String
    
    Dim tmpDC As Integer        'Color
    Dim tmpDL As Integer        'Days Late
    Dim tmpS As Integer         'Scrap
    Dim tmpTC As Integer        'Temp Color
    Dim tmpTL As Integer        'Temp Days Late
    
    Dim tmpWC As String         'Workcenter
    Dim tmpOC As String         'Operation Code
    Dim tmpSa As String         'Status
    Dim tmpSe As String         'Step
    
    Call ClearListView(tmpList)
    
    tmpSt = "select D.PartNo, D.Priority, D.PartDesc, D.QtyOrdered, D.QtyToMake, D.WorkCode JobType, D.JobNotes, case when " & _
                   "D.Status = 'Closed' or R.ActualEndDate is not null then 'X' when R.ActualStartDate is not null then 'IP' " & _
                   "else '' end Status, R.StepNo, R.WorkOrVend, R.WorkCntr, R.OperCode OpCode, R.VendCode, R.SetupTime, R.TimeUnit " & _
                   "SetupUnit, R.Descrip, R.ActualPcsGood, R.ActualPcsScrap, R.EstimStartDate, R.EstimEndDate, R.TotActHrs, " & _
                   "R.TotActHrs, R.TotEstHrs, R.ActualEndDate, MRB.Disposition, MRB.Notes " & _
            "from OrderDet D " & _
            "left join OrderRouting R on R.JobNo = D.JobNo " & _
            "left join VendCode V on V.VendCode = R.VendCode " & _
            "left join ZZZ_MRB MRB on MRB.JobNo = D.JobNo and MRB.StepNo = R.StepNo " & _
            "where D.JobNo = 'JOBNO' " & _
            "order by R.StepNo"
    
    tmpSt = Replace(tmpSt, "JOBNO", tmpJob)
    Set tmpRS = ExecSQL(tmpSt)
    
    tmpDC = 0
    tmpDL = -999
    tmpR = 0
    tmpComp = ""
    tmpWork = ""
    tmpActual = Now()
    tmpScrap = 0
    tmpDisp = 0
    tmpNotes = ""
    
    If tmpRS.RecordCount > 0 Then
        ImportJob = Trim(tmpRS("PartNo").value)
        
        tmpForm.txtJobNo.Text = tmpJob
        tmpForm.txtPriority.Text = ImportPriority(tmpRS("Priority").value)
        tmpForm.txtPartNo.Text = UCase(Trim(tmpRS("PartNo").value))
        tmpForm.txtPartDesc.Text = UCase(Trim(tmpRS("PartDesc").value))
        tmpForm.txtOrderQty.Text = Trim(tmpRS("QtyOrdered").value)
        tmpForm.txtMakeQty.Text = Trim(tmpRS("QtyToMake").value)
        tmpForm.txtJobType.Text = Trim(tmpRS("JobType").value)
        tmpForm.txtJobNotes.Text = UCase(Trim(tmpRS("JobNotes").value))
        
        While Not tmpRS.EOF
            Call AddRowListView(tmpList)
            
            tmpTC = -1
            
            tmpSa = tmpRS("Status").value
            tmpSe = Trim(tmpRS("StepNo").value)
            
            If tmpSa = "X" And tmpSe = tmpStep Then
                Call WriteListView(tmpList, tmpR, 1, "X>")
                Call ColorListView(tmpList, tmpR, &HFF8080)         'Light Blue
                
                tmpComp = "X"
                If Not IsNull(tmpRS("WorkCntr")) Then _
                    tmpWork = Trim(tmpRS("WorkCntr").value)
                If Not IsNull(tmpRS("ActualEndDate")) Then _
                    tmpActual = tmpRS("ActualEndDate").value
                If Not IsNull(tmpRS("ActualPcsScrap")) Then _
                    tmpScrap = tmpRS("ActualPcsScrap").value
                If Not IsNull(tmpRS("Disposition")) Then _
                    tmpDisp = tmpRS("Disposition").value
                If Not IsNull(tmpRS("Notes")) Then _
                    tmpNotes = Trim(tmpRS("Notes").value)
            ElseIf tmpSa = "X" Then
                Call WriteListView(tmpList, tmpR, 1, "X")
                Call ColorListView(tmpList, tmpR, &H80000011)       'Grey
            ElseIf tmpSe = tmpStep Then
                Call WriteListView(tmpList, tmpR, 1, ">>")
                Call ColorListView(tmpList, tmpR, &HC00000)         'Blue
                
                If Not IsNull(tmpRS("WorkCntr")) Then _
                    tmpWork = Trim(tmpRS("WorkCntr").value)
                If Not IsNull(tmpRS("ActualEndDate")) Then _
                    tmpActual = tmpRS("ActualEndDate").value
                If Not IsNull(tmpRS("ActualPcsScrap")) Then _
                    tmpScrap = tmpRS("ActualPcsScrap").value
                If Not IsNull(tmpRS("Disposition")) Then _
                    tmpDisp = tmpRS("Disposition").value
                If Not IsNull(tmpRS("Notes")) Then _
                    tmpNotes = Trim(tmpRS("Notes").value)
            Else
                Call ColorListView(tmpList, tmpR, &H80000012)       'Black
            End If
            
            Call WriteListView(tmpList, tmpR, 2, tmpSe)
            
            If tmpRS("WorkOrVend").value = 0 Then
                tmpWC = Trim(tmpRS("WorkCntr").value)
                tmpOC = Trim(tmpRS("OpCode").value)
            Else
                tmpWC = "OUTSOURCE"
                tmpOC = Trim(tmpRS("VendCode").value)
            End If
            
            Call WriteListView(tmpList, tmpR, 3, tmpWC)
            
            If tmpOC = "SHIP INV" And tmpRS("SetupUnit").value <> "M" And tmpRS("SetupTime").value > 0 Then
                Call WriteListView(tmpList, tmpR, 4, "SHIP INV**")
            Else
                Call WriteListView(tmpList, tmpR, 4, tmpOC)
            End If
            
            Call WriteListView(tmpList, tmpR, 5, ConvertDesc(tmpRS("Descrip").value))
            Call WriteListView(tmpList, tmpR, 6, tmpRS("Descrip").value)
            
            If tmpSa <> "" Then
                Call WriteListView(tmpList, tmpR, 7, tmpRS("ActualPcsGood").value)
                
                tmpS = tmpRS("ActualPcsScrap").value
                
                If Not IsNull(tmpRS("Disposition")) Then
                    If tmpRS("Disposition").value > 0 Then
                        Call WriteListView(tmpList, tmpR, 8, tmpS & "*")
                    Else
                        Call WriteListView(tmpList, tmpR, 8, tmpS)
                    End If
                Else
                    Call WriteListView(tmpList, tmpR, 8, tmpS)
                End If
                
                If tmpS > 0 Then Call BoldListViewItem(tmpList, tmpR, 8, True)
            End If
            
            If Not IsNull(tmpRS("EstimStartDate")) Then
                Call WriteListView(tmpList, tmpR, 9, Format(tmpRS("EstimStartDate").value, "m/d"))
                If tmpSa <> "X" Then
                    If CDate(tmpRS("EstimStartDate").value) < CDate(Now()) Then
                        If tmpWC <> "MATLOG" And tmpDC = 0 Then tmpDC = 1
                        tmpTC = 1
                    Else
                        tmpTC = 0
                    End If
                End If
            End If
            
            If Not IsNull(tmpRS("EstimEndDate")) Then
                Call WriteListView(tmpList, tmpR, 10, Format(tmpRS("EstimEndDate").value, "m/d"))
                
                If tmpSa <> "X" Then
                    tmpTL = CalcWork(tmpRS("EstimEndDate").value, Now()) - 1
                    If tmpWC <> "MATLOG" And tmpTL > tmpDL Then tmpDL = tmpTL
                End If
            End If
            
            If tmpTL > 5 Then
                Call WriteListView(tmpList, tmpR, 11, tmpTL)
                Call ColorJob(tmpList, tmpR, &H40C0&)               'Orange
            ElseIf tmpTL > 0 Then
                Call WriteListView(tmpList, tmpR, 11, tmpTL)
                Call ColorJob(tmpList, tmpR, &HFF&)                 'Red
            ElseIf tmpTC = 1 Then
                Call ColorJob(tmpList, tmpR, &HC0C0&)               'Yellow
            ElseIf tmpTC = 0 Then
                Call ColorJob(tmpList, tmpR, &HC000&)               'Green
            End If
            
            Call WriteListView(tmpList, tmpR, 12, Format(tmpRS("TotEstHrs").value, "0.00"))
            If tmpOC = "SHIP INV" And tmpRS("SetupUnit").value <> "M" And tmpRS("SetupTime").value > 0 Then _
                Call BoldListViewItem(tmpList, tmpR, 12, True)
            
            If tmpSa <> "" Then
                Call WriteListView(tmpList, tmpR, 13, Format(tmpRS("TotActHrs").value, "0.00"))
                
                If Not IsNull(tmpRS("ActualEndDate")) Then _
                    Call WriteListView(tmpList, tmpR, 14, Format(tmpRS("ActualEndDate").value, "m/d"))
            End If
            
            If tmpSe = tmpStep Then
                tmpForm.txtOpDesc.Text = UCase(tmpRS("Descrip").value)
                tmpForm.mpJobDetail.Pages(0).Visible = True
                tmpForm.mpJobDetail.value = 0
            End If
            
            tmpR = tmpR + 1
            tmpRS.MoveNext
        Wend
    Else
        MsgBox "ERROR: No Operations (" & tmpJob & ")", vbCritical
    End If
    
    If tmpDL > 5 Then
        frmSchedDetail.txtDaysLate.BackColor = &H80FF&      'Orange
        frmSchedDetail.txtDaysLate.Text = tmpDL
    ElseIf tmpDL > 0 Then
        frmSchedDetail.txtDaysLate.BackColor = &HFF&        'Red
        frmSchedDetail.txtDaysLate.Text = tmpDL
    ElseIf tmpDC = 1 Then
        frmSchedDetail.txtDaysLate.BackColor = &H80FFFF     'Yellow
        frmSchedDetail.txtDaysLate.Text = 0
    Else
        frmSchedDetail.txtDaysLate.BackColor = &H80FF80     'Green
        frmSchedDetail.txtDaysLate.Text = 0
    End If
    
    Set tmpRS = Nothing
End Function

 

[sijpie]

Your code runs the SQL query, but at a glance I can't see which value(s) is used for the total hours. You mention it populates a form, but I don't see any form elements.

Just to make sure I understand you correctly:
What you would like is to create a macro that runs through each row on the shheet and pulls the total hours from the sql database and adds it to a column at the right of the table. is that correct?

 

[TCII]

Yes that is correct. If it would be helpful I can add the user form code as well.

 

[sijpie]

THe piece of code I need is in the userform, where the value is calculated to display in the total hrs textbox. Because that tells me how the value is calculated. From the code above, I can't distill this.

 

[TCII]

Here is the Code from that user form.

Option Explicit

Public WithEvents objOrder As ListView
Public WithEvents objJob As ListView
Public WithEvents objRequired As ListView
Public WithEvents objIssued As ListView
Public WithEvents objInv As ListView
Public WithEvents objIP As ListView
Public WithEvents objDemand As ListView
Public WithEvents objNC As ListView
Public WithEvents objPO As ListView
Public WithEvents objShip As ListView
Public WithEvents objHours As ListView
Public WithEvents objMach As ListView
Public WithEvents objJobs As ListView

Private Sub UserForm_Initialize()
    Me.StartUpPosition = 0
    Me.Left = Application.Left + (0.5 * Application.Width) - (0.5 * Me.Width)
    Me.Top = Application.Top + (0.5 * Application.Height) - (0.5 * Me.Height)
    
    frmSchedDetail.mpSchedDetail.value = 0
    Set objOrder = CreateListView(mpSchedDetail.Pages(0), frmOrder)
    Call FormatOrder(mpSchedDetail.Pages(0), objOrder, frmOrder)
    
    frmSchedDetail.mpSchedDetail.value = 1
    Set objJob = CreateListView(mpSchedDetail.Pages(1), frmJob)
    Call FormatJob(mpSchedDetail.Pages(1), objJob, frmJob)
    
    frmSchedDetail.mpSchedDetail.value = 2
    Set objRequired = CreateListView(mpSchedDetail.Pages(2), frmRequired)
    Call FormatMatl(mpSchedDetail.Pages(2), objRequired, "REQUIRED", frmRequired)
    
    frmSchedDetail.mpSchedDetail.value = 2
    Set objIssued = CreateListView(mpSchedDetail.Pages(2), frmIssued)
    Call FormatMatl(mpSchedDetail.Pages(2), objIssued, "ISSUED", frmIssued)
    
    frmSchedDetail.mpSchedDetail.value = 2
    Set objInv = CreateListView(mpSchedDetail.Pages(2), frmInv)
    Call FormatInv(mpSchedDetail.Pages(2), objInv, "INVENTORY", frmInv)
    
    frmSchedDetail.mpSchedDetail.value = 2
    Set objIP = CreateListView(mpSchedDetail.Pages(2), frmIP)
    Call FormatInv(mpSchedDetail.Pages(2), objIP, "IN-PROCESS", frmIP)
    
    frmSchedDetail.mpSchedDetail.value = 2
    Set objDemand = CreateListView(mpSchedDetail.Pages(2), frmDemand)
    Call FormatInv(mpSchedDetail.Pages(2), objDemand, "DEMAND", frmDemand)
    
    frmSchedDetail.mpSchedDetail.value = 3
    Set objNC = CreateListView(mpSchedDetail.Pages(3), frmNC)
    Call FormatNC(mpSchedDetail.Pages(3), objNC, frmNC)
    
    'PO - 4
    'Ship - 5
    
    frmSchedDetail.mpSchedDetail.value = 6
    Set objHours = CreateListView(mpSchedDetail.Pages(6), frmHours)
    Call FormatHours(mpSchedDetail.Pages(6), objHours, frmHours)
    
    frmSchedDetail.mpSchedDetail.value = 7
    Set objMach = CreateListView(frmMach1, frmMach2)
    Set objJobs = CreateListView(frmJobs1, frmJobs2)
    Call FormatMach(frmMach1, objMach, frmMach2)
    Call FormatMach(frmJobs1, objJobs, frmJobs2)
End Sub

Private Sub txtJobNo_Change()
    txtJobNo_Matl.Text = txtJobNo.Text
    txtJobNo_NC.Text = txtJobNo.Text
    txtJobNo_PO.Text = txtJobNo.Text
    txtJobNo_Ship.Text = txtJobNo.Text
    txtJobNo_Hours.Text = txtJobNo.Text
    txtJobNo_Mach.Text = txtJobNo.Text
End Sub

Private Sub txtPriority_Change()
    txtPriority_Matl.Text = txtPriority.Text
    txtPriority_NC.Text = txtPriority.Text
    txtPriority_PO.Text = txtPriority.Text
    txtPriority_Ship.Text = txtPriority.Text
    txtPriority_Hours.Text = txtPriority.Text
    txtPriority_Mach.Text = txtPriority.Text
    
    Call ColorPriority(txtPriority)
    Call ColorPriority(txtPriority_Matl)
    Call ColorPriority(txtPriority_NC)
    Call ColorPriority(txtPriority_PO)
    Call ColorPriority(txtPriority_Ship)
    Call ColorPriority(txtPriority_Hours)
    Call ColorPriority(txtPriority_Mach)
End Sub

Private Sub ColorPriority(ByVal tmpText As Variant)
    Dim tmpT As String
    tmpT = tmpText.Text

    If tmpT = "HIGH-65" Then
        tmpText.BackColor = &H80FF&                         'Orange
    ElseIf tmpT = "LOW-35" Then
        tmpText.BackColor = &H80FF80                        'Green
    ElseIf tmpT = "HOLD-5" Then
        tmpText.BackColor = &H8000000A                      'Active Border
    Else
        tmpText.BackColor = &H80000005                      'Window Background
    End If
End Sub

Private Sub txtPartNo_Change()
    txtPartNo_Matl.Text = txtPartNo.Text
    txtPartNo_NC.Text = txtPartNo.Text
    txtPartNo_PO.Text = txtPartNo.Text
    txtPartNo_Ship.Text = txtPartNo.Text
    txtPartNo_Hours.Text = txtPartNo.Text
    txtPartNo_Mach.Text = txtPartNo.Text
End Sub

Private Sub txtPartDesc_Change()
    txtPartDesc_Matl.Text = txtPartDesc.Text
    txtPartDesc_NC.Text = txtPartDesc.Text
    txtPartDesc_PO.Text = txtPartDesc.Text
    txtPartDesc_Ship.Text = txtPartDesc.Text
    txtPartDesc_Hours.Text = txtPartDesc.Text
    txtPartDesc_Mach.Text = txtPartDesc.Text
End Sub

Private Sub txtOrderQty_Change()
    txtOrderQty_Matl.Text = txtOrderQty.Text
    txtOrderQty_NC.Text = txtOrderQty.Text
    txtOrderQty_PO.Text = txtOrderQty.Text
    txtOrderQty_Ship.Text = txtOrderQty.Text
    txtOrderQty_Hours.Text = txtOrderQty.Text
    txtOrderQty_Mach.Text = txtOrderQty.Text
End Sub

Private Sub txtMakeQty_Change()
    txtMakeQty_Matl.Text = txtMakeQty.Text
    txtMakeQty_NC.Text = txtMakeQty.Text
    txtMakeQty_PO.Text = txtMakeQty.Text
    txtMakeQty_Ship.Text = txtMakeQty.Text
    txtMakeQty_Hours.Text = txtMakeQty.Text
    txtMakeQty_Mach.Text = txtMakeQty.Text
End Sub

Private Sub txtDaysLate_Change()
    txtDaysLate_Matl.Text = txtDaysLate.Text
    txtDaysLate_NC.Text = txtDaysLate.Text
    txtDaysLate_PO.Text = txtDaysLate.Text
    txtDaysLate_Ship.Text = txtDaysLate.Text
    txtDaysLate_Hours.Text = txtDaysLate.Text
    txtDaysLate_Mach.Text = txtDaysLate.Text
    
    txtDaysLate_Matl.BackColor = txtDaysLate.BackColor
    txtDaysLate_NC.BackColor = txtDaysLate.BackColor
    txtDaysLate_PO.BackColor = txtDaysLate.BackColor
    txtDaysLate_Ship.BackColor = txtDaysLate.BackColor
    txtDaysLate_Hours.BackColor = txtDaysLate.BackColor
    txtDaysLate_Mach.BackColor = txtDaysLate.BackColor
End Sub

Private Sub txtJobType_Change()
    txtJobType_Matl.Text = txtJobType.Text
    txtJobType_NC.Text = txtJobType.Text
    txtJobType_PO.Text = txtJobType.Text
    txtJobType_Ship.Text = txtJobType.Text
    txtJobType_Hours.Text = txtJobType.Text
    txtJobType_Mach.Text = txtJobType.Text
End Sub

Private Sub mpSchedDetail_Change()
    Select Case mpSchedDetail.value
        Case 0
            Call RedrawObject(objOrder)
        Case 1
            Call RedrawObject(objJob)
        Case 2
            Call RedrawObject(objRequired)
            Call RedrawObject(objIssued)
            Call RedrawObject(objInv)
            Call RedrawObject(objIP)
            Call RedrawObject(objDemand)
        Case 3
            Call RedrawObject(objNC)
        Case 4
            Call RedrawObject(objPO)
        Case 5
            Call RedrawObject(objShip)
        Case 6
            Call RedrawObject(objHours)
        Case 7
            Call RedrawObject(objMach)
            Call RedrawObject(objJobs)
    End Select
End Sub

Private Sub objOrder_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
                               ByVal X As stdole.OLE_XPOS_PIXELS, ByVal Y As stdole.OLE_YPOS_PIXELS)
    If Button = 2 Then
        objOrder.Tag = objOrder.SelectedItem.SubItems(2)
        
        Call ConnectSQL
        Call ImportOrder(Me, objOrder, objOrder.Tag)
        Call ImportJob(Me, objJob, objOrder.Tag)
        Call ImportRequired(objRequired, objOrder.Tag)
        Call ImportIssued(objIssued, objOrder.Tag)
        If ImportNC(objNC, objOrder.Tag) > 0 Then mpSchedDetail.Pages(3).Visible = True
        Call CloseSQL
        
        mpJobDetail.Pages(0).Visible = False
        mpJobDetail.value = 1
        
        mpSchedDetail.Pages(6).Visible = False
        mpSchedDetail.Pages(7).Visible = False
        mpSchedDetail.value = 1
    End If
End Sub

Private Sub cbExcludeClosed_Click()
    Call ConnectSQL
    Call ImportOrder(Me, objOrder, objOrder.Tag)
    Call CloseSQL
End Sub

Private Sub objJob_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
                             ByVal X As stdole.OLE_XPOS_PIXELS, ByVal Y As stdole.OLE_YPOS_PIXELS)
    If Button = 2 Then
        objJob.Tag = objJob.SelectedItem.SubItems(2)

        Call ConnectSQL
        Call ImportJob(Me, objJob, objOrder.Tag, objJob.Tag)
        Call CloseSQL
        
        If ImportHours(objHours, objOrder.Tag, objJob.Tag) > 0 Then mpSchedDetail.Pages(6).Visible = True
        
        Call ImportMachHist(objMach, objOrder.Tag, objJob.Tag)
        Call ImportJobs(objJobs, objOrder.Tag, objJob.Tag)
        mpSchedDetail.Pages(7).Visible = True
        
        mpSchedDetail.value = 1
    End If
End Sub


Private Sub objRequired_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
                                  ByVal X As stdole.OLE_XPOS_PIXELS, ByVal Y As stdole.OLE_YPOS_PIXELS)
    Dim tmpPart As String
    
    If Button = 2 Then
        tmpPart = objRequired.SelectedItem.SubItems(2)
        
        Call SelectInv(objRequired, tmpPart)
        Call SelectInv(objIssued, tmpPart)
        
        Call ConnectSQL
        Call ImportInv(objInv, tmpPart)
        Call ImportIP(objIP, tmpPart)
        Call ImportDemand(objDemand, tmpPart)
        Call CloseSQL
        
        Set objRequired.SelectedItem = Nothing
    End If
End Sub

Private Sub objIssued_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
                                ByVal X As stdole.OLE_XPOS_PIXELS, ByVal Y As stdole.OLE_YPOS_PIXELS)
    Dim tmpPart As String
    
    If Button = 2 Then
        tmpPart = objIssued.SelectedItem.SubItems(2)
        
        Call SelectInv(objRequired, tmpPart)
        Call SelectInv(objIssued, tmpPart)
        
        Call ConnectSQL
        Call ImportInv(objInv, tmpPart)
        Call ImportIP(objIP, tmpPart)
        Call ImportDemand(objDemand, tmpPart)
        Call CloseSQL
        
        Set objIssued.SelectedItem = Nothing
    End If
End Sub

Private Sub SelectInv(ByVal tmpList As ListView, ByVal tmpPart As String)
    Dim tmpR As Integer
    
    For tmpR = 0 To tmpList.ListItems.Count - 1
        If ReadListView(tmpList, tmpR, 2) = tmpPart Then
            Call WriteListView(tmpList, tmpR, 1, ">>")
        Else
            Call WriteListView(tmpList, tmpR, 1, "")
        End If
    Next tmpR
End Sub





Private Sub txtWeekAdj_Change()
    If VerifyWeek And VerifyMach And VerifyNotes Then
        btnUpdateMach.Enabled = True
    Else
        btnUpdateMach.Enabled = False
    End If
End Sub

Private Sub txtMach_Change()
    If VerifyWeek And VerifyMach And VerifyNotes Then
        btnUpdateMach.Enabled = True
    Else
        btnUpdateMach.Enabled = False
    End If
End Sub

Public Sub txtNotes_Change()
    If VerifyWeek And VerifyMach And VerifyNotes Then
        btnUpdateMach.Enabled = True
    Else
        btnUpdateMach.Enabled = False
    End If
End Sub

Private Function VerifyWeek() As Boolean
    Dim tmpWS As String
    Dim tmpWA As String
    
    tmpWS = txtWeekSched.Text
    tmpWA = txtWeekAdj.Text
    
    If tmpWA = "" Or tmpWA = tmpWS Then
        VerifyWeek = True
        txtWeekAdj.BackColor = &HFFFFFF                                 'Default
    Else
        If IsNumeric(tmpWA) Then
            If CInt(tmpWA) >= 1 And CInt(tmpWA) <= 52 Then
                VerifyWeek = True
                
                If CInt(tmpWA) < CInt(tmpWS) Then
                    txtWeekAdj.BackColor = &H80FF80                     'Light Green
                ElseIf CInt(tmpWA) > CInt(tmpWS) Then
                    txtWeekAdj.BackColor = &H8080FF                     'Light Red
                Else
                    Stop
                End If
            Else
                VerifyWeek = False
                txtWeekAdj.BackColor = &HFF                             'Red
            End If
        Else
            VerifyWeek = False
            txtWeekAdj.BackColor = &HFF&
        End If
    End If
End Function

Private Function VerifyMach() As Boolean
    Dim tmpM As String
    tmpM = txtMach.Text
    
    If tmpM = "" Then
        VerifyMach = True
        txtMach.BackColor = &HFFFFFF                                    'Default
    Else
        If IsNumeric(tmpM) Then
            If CInt(tmpM) >= 1 And CInt(tmpM) <= 999 Then
                VerifyMach = True
                txtMach.BackColor = &HFFFFFF                            'Default
            Else
                VerifyMach = False
                txtMach.BackColor = &HFF                                'Red
            End If
        Else
            VerifyMach = False
            txtMach.BackColor = &HFF                                    'Red
        End If
    End If
End Function

Private Function VerifyNotes() As Boolean
    Dim tmpN As String
    tmpN = txtNotes.Text
    
    If tmpN = txtNotes.Tag Then
        VerifyNotes = True
        txtNotes.BackColor = &HFFFFFF                                   'Default
    ElseIf Len(tmpN) > 50 Then
        VerifyNotes = False
        txtNotes.BackColor = &HFF                                       'Red
    Else
        VerifyNotes = True
        txtNotes.BackColor = &H80FF80                                   'Light Green
    End If
End Function

Private Sub btnUpdateMach_Click()
    Me.Hide
    Call UpdateWeekMach2(Me)
    Unload Me
End Sub









Private Sub btnCancel_Click()
    Unload Me
End Sub

 

[sijpie]

Thanks. This shows that the code is pretty complicated to understand. I thought it might have been a simple userform. And there are a lot of functions missing in the code you have posted so far. Who wrote the code? I think it will be far easier to get back them with your question.