optimize.txt

Public Sub ConsolidateChanges()
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim IsStillInToolList As Boolean
    Dim InOriginalToolList As Boolean
    Dim IsDuplicate As Boolean
    j = 0
    i = 1
    k = 1
    While i <= CreateRouting.ToolingChangeList.ListItems.Count
        Select Case CreateRouting.ToolingChangeList.ListItems.Item(i).SubItems(2)
        Case "REMOVED"
            j = 0
            'CHECK IF REMOVED TOOL WAS EVER IN THE PROCESS
            InOriginalToolList = False
            While j <= 400 'There can be up to 400 tools
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = OriginalTools(j) Then
                    InOriginalToolList = True
					exit do'Stop checking
                End If
                j = j + 1
            Wend
            'CHECK IF REMOVED TOOL IS A DUPLICATE REMOVAL
            IsDuplicate = False
            k = 1
            While k <= CreateRouting.ToolingChangeList.ListItems.Count
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = CreateRouting.ToolingChangeList.ListItems.Item(k).Text And i <> k And CreateRouting.ToolingChangeList.ListItems.Item(i).SubItems(2) = CreateRouting.ToolingChangeList.ListItems.Item(k).SubItems(2) Then
                    IsDuplicate = True
					exit do 'Stop checking
                End If
                k = k + 1
            Wend
            'CHECK IF REMOVED TOOL STILL EXISTS ELSEWHERE IN THE PROCESS
            Set sqlRS = New ADODB.Recordset
			' Stored procedure candidate
			' Check a process' [ToolList Item] records for a specific cribmaster id  
			call findCribItem(table,processid)
            sqlRS.Open "SELECT CRIBTOOLID FROM [TOOLLIST ITEM] WHERE PROCESSID =" + Str(ProcessID), sqlConn, adOpenKeyset, adLockReadOnly
            IsStillInToolList = False
            While Not sqlRS.EOF
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = sqlRS.Fields("CRIBTOOLID") Then
                    IsStillInToolList = True
					Exit Do 'Stop checking
                End If
                sqlRS.MoveNext
            Wend
            sqlRS.Close
			' Stored procedure candidate
			' Check a process' [ToolList Misc] records for a specific cribmaster id  
            sqlRS.Open "SELECT CRIBTOOLID FROM [TOOLLIST MISC] WHERE PROCESSID =" + Str(ProcessID), sqlConn, adOpenKeyset, adLockReadOnly
            While Not sqlRS.EOF
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = sqlRS.Fields("CRIBTOOLID") Then
                    IsStillInToolList = True
                End If
                sqlRS.MoveNext
            Wend
            sqlRS.Close
            If InOriginalToolList And Not IsStillInToolList And Not IsDuplicate Then
                i = i + 1
            Else
                CreateRouting.ToolingChangeList.ListItems.Remove (i)
            End If
        Case "REMOVEDM"
            j = 0
            'CHECK IF REMOVED TOOL WAS EVER IN THE PROCESS
            InOriginalToolList = False
            While j <= 400
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = OriginalTools(j) Then
                    InOriginalToolList = True
                End If
                j = j + 1
            Wend
            'CHECK IF REMOVED TOOL IS A DUPLICATE REMOVAL
            IsDuplicate = False
            k = 1
            While k <= CreateRouting.ToolingChangeList.ListItems.Count
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = CreateRouting.ToolingChangeList.ListItems.Item(k).Text And i <> k And CreateRouting.ToolingChangeList.ListItems.Item(i).SubItems(2) = CreateRouting.ToolingChangeList.ListItems.Item(k).SubItems(2) Then
                    IsDuplicate = True
                End If
                k = k + 1
            Wend
            'CHECK IF REMOVED TOOL STILL EXISTS ELSEWHERE IN THE PROCESS
            Set sqlRS = New ADODB.Recordset
            sqlRS.Open "SELECT CRIBTOOLID FROM [TOOLLIST ITEM] WHERE PROCESSID =" + Str(ProcessID), sqlConn, adOpenKeyset, adLockReadOnly
            IsStillInToolList = False
            While Not sqlRS.EOF
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = sqlRS.Fields("CRIBTOOLID") Then
                    IsStillInToolList = True
                End If
                sqlRS.MoveNext
            Wend
            sqlRS.Close
            sqlRS.Open "SELECT CRIBTOOLID FROM [TOOLLIST FIXTURE] WHERE PROCESSID =" + Str(ProcessID), sqlConn, adOpenKeyset, adLockReadOnly
            IsStillInToolList = False
            While Not sqlRS.EOF
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = sqlRS.Fields("CRIBTOOLID") Then
                    IsStillInToolList = True
                End If
                sqlRS.MoveNext
            Wend
            sqlRS.Close
            sqlRS.Open "SELECT CRIBTOOLID FROM [TOOLLIST MISC] WHERE PROCESSID =" + Str(ProcessID), sqlConn, adOpenKeyset, adLockReadOnly
            While Not sqlRS.EOF
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = sqlRS.Fields("CRIBTOOLID") Then
                    IsStillInToolList = True
                End If
                sqlRS.MoveNext
            Wend
            sqlRS.Close
            If InOriginalToolList And Not IsStillInToolList And Not IsDuplicate Then
                i = i + 1
            Else
                CreateRouting.ToolingChangeList.ListItems.Remove (i)
            End If
        Case "REMOVEDF"
            j = 0
            'CHECK IF REMOVED TOOL WAS EVER IN THE PROCESS
            InOriginalToolList = False
            While j <= 400
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = OriginalTools(j) Then
                    InOriginalToolList = True
                End If
                j = j + 1
            Wend
            'CHECK IF REMOVED TOOL IS A DUPLICATE REMOVAL
            IsDuplicate = False
            k = 1
            While k <= CreateRouting.ToolingChangeList.ListItems.Count
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = CreateRouting.ToolingChangeList.ListItems.Item(k).Text And i <> k And CreateRouting.ToolingChangeList.ListItems.Item(i).SubItems(2) = CreateRouting.ToolingChangeList.ListItems.Item(k).SubItems(2) Then
                    IsDuplicate = True
                End If
                k = k + 1
            Wend
            'CHECK IF REMOVED TOOL STILL EXISTS ELSEWHERE IN THE PROCESS
            Set sqlRS = New ADODB.Recordset
            sqlRS.Open "SELECT CRIBTOOLID FROM [TOOLLIST FIXTURE] WHERE PROCESSID =" + Str(ProcessID), sqlConn, adOpenKeyset, adLockReadOnly
            IsStillInToolList = False
            While Not sqlRS.EOF
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = sqlRS.Fields("CRIBTOOLID") Then
                    IsStillInToolList = True
                End If
                sqlRS.MoveNext
            Wend
            sqlRS.Close
            sqlRS.Open "SELECT CRIBTOOLID FROM [TOOLLIST ITEM] WHERE PROCESSID =" + Str(ProcessID), sqlConn, adOpenKeyset, adLockReadOnly
            While Not sqlRS.EOF
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = sqlRS.Fields("CRIBTOOLID") Then
                    IsStillInToolList = True
                End If
                sqlRS.MoveNext
            Wend
            sqlRS.Close
            sqlRS.Open "SELECT CRIBTOOLID FROM [TOOLLIST FIXTURE] WHERE PROCESSID =" + Str(ProcessID), sqlConn, adOpenKeyset, adLockReadOnly
            While Not sqlRS.EOF
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = sqlRS.Fields("CRIBTOOLID") Then
                    IsStillInToolList = True
                End If
                sqlRS.MoveNext
            Wend
            sqlRS.Close
            If InOriginalToolList And Not IsStillInToolList And Not IsDuplicate Then
                i = i + 1
            Else
                CreateRouting.ToolingChangeList.ListItems.Remove (i)
            End If
        Case "ADDED"
            j = 0
            'CHECK IF ADDED TOOL ALREADY EXISTED IN THE PROCESS
            InOriginalToolList = False
            While j <= 400
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = OriginalTools(j) Then
                    InOriginalToolList = True
                End If
                j = j + 1
            Wend
            'CHECK IF ADDED TOOL IS A DUPLICATE
            IsDuplicate = False
            k = 1
            While k <= CreateRouting.ToolingChangeList.ListItems.Count
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = CreateRouting.ToolingChangeList.ListItems.Item(k).Text And i <> k And CreateRouting.ToolingChangeList.ListItems.Item(i).SubItems(2) = CreateRouting.ToolingChangeList.ListItems.Item(k).SubItems(2) Then
                    IsDuplicate = True
                End If
                k = k + 1
            Wend
            'CHECK IF ADDED TOOL STILL EXISTS ELSEWHERE IN THE PROCESS
            Set sqlRS = New ADODB.Recordset
            sqlRS.Open "SELECT CRIBTOOLID FROM [TOOLLIST ITEM] WHERE PROCESSID =" + Str(ProcessID), sqlConn, adOpenKeyset, adLockReadOnly
            IsStillInToolList = False
            While Not sqlRS.EOF
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = sqlRS.Fields("CRIBTOOLID") Then
                    IsStillInToolList = True
                End If
                sqlRS.MoveNext
            Wend
            sqlRS.Close
            sqlRS.Open "SELECT CRIBTOOLID FROM [TOOLLIST FIXTURE] WHERE PROCESSID =" + Str(ProcessID), sqlConn, adOpenKeyset, adLockReadOnly
            While Not sqlRS.EOF
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = sqlRS.Fields("CRIBTOOLID") Then
                    IsStillInToolList = True
                End If
                sqlRS.MoveNext
            Wend
            sqlRS.Close
            sqlRS.Open "SELECT CRIBTOOLID FROM [TOOLLIST MISC] WHERE PROCESSID =" + Str(ProcessID), sqlConn, adOpenKeyset, adLockReadOnly
            While Not sqlRS.EOF
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = sqlRS.Fields("CRIBTOOLID") Then
                    IsStillInToolList = True
                End If
                sqlRS.MoveNext
            Wend
            sqlRS.Close
            If Not InOriginalToolList And IsStillInToolList And Not IsDuplicate Then
                i = i + 1
            Else
                CreateRouting.ToolingChangeList.ListItems.Remove (i)
            End If
        Case "ADDEDM"
            j = 0
            'CHECK IF ADDED TOOL ALREADY EXISTED IN THE PROCESS
            InOriginalToolList = False
            While j <= 100
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = OriginalTools(j) Then
                    InOriginalToolList = True
                End If
                j = j + 1
            Wend
            'CHECK IF ADDED TOOL IS A DUPLICATE
            IsDuplicate = False
            k = 1
            While k <= CreateRouting.ToolingChangeList.ListItems.Count
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = CreateRouting.ToolingChangeList.ListItems.Item(k).Text And i <> k And CreateRouting.ToolingChangeList.ListItems.Item(i).SubItems(2) = CreateRouting.ToolingChangeList.ListItems.Item(k).SubItems(2) Then
                    IsDuplicate = True
                End If
                k = k + 1
            Wend
            'CHECK IF ADDED TOOL STILL EXISTS ELSEWHERE IN THE PROCESS
            Set sqlRS = New ADODB.Recordset
            sqlRS.Open "SELECT CRIBTOOLID FROM [TOOLLIST MISC] WHERE PROCESSID =" + Str(ProcessID), sqlConn, adOpenKeyset, adLockReadOnly
            IsStillInToolList = False
            While Not sqlRS.EOF
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = sqlRS.Fields("CRIBTOOLID") Then
                    IsStillInToolList = True
                End If
                sqlRS.MoveNext
            Wend
            sqlRS.Close
            sqlRS.Open "SELECT CRIBTOOLID FROM [TOOLLIST FIXTURE] WHERE PROCESSID =" + Str(ProcessID), sqlConn, adOpenKeyset, adLockReadOnly
            While Not sqlRS.EOF
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = sqlRS.Fields("CRIBTOOLID") Then
                    IsStillInToolList = True
                End If
                sqlRS.MoveNext
            Wend
            sqlRS.Close
            sqlRS.Open "SELECT CRIBTOOLID FROM [TOOLLIST ITEM] WHERE PROCESSID =" + Str(ProcessID), sqlConn, adOpenKeyset, adLockReadOnly
            While Not sqlRS.EOF
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = sqlRS.Fields("CRIBTOOLID") Then
                    IsStillInToolList = True
                End If
                sqlRS.MoveNext
            Wend
            sqlRS.Close
            If Not InOriginalToolList And IsStillInToolList And Not IsDuplicate Then
                i = i + 1
            Else
                CreateRouting.ToolingChangeList.ListItems.Remove (i)
            End If
        Case "ADDEDF"
            j = 0
            'CHECK IF ADDED TOOL ALREADY EXISTED IN THE PROCESS
            InOriginalToolList = False
            While j <= 100
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = OriginalTools(j) Then
                    InOriginalToolList = True
                End If
                j = j + 1
            Wend
            'CHECK IF ADDED TOOL IS A DUPLICATE
            IsDuplicate = False
            k = 1
            While k <= CreateRouting.ToolingChangeList.ListItems.Count
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = CreateRouting.ToolingChangeList.ListItems.Item(k).Text And i <> k And CreateRouting.ToolingChangeList.ListItems.Item(i).SubItems(2) = CreateRouting.ToolingChangeList.ListItems.Item(k).SubItems(2) Then
                    IsDuplicate = True
                End If
                k = k + 1
            Wend
            'CHECK IF ADDED TOOL STILL EXISTS ELSEWHERE IN THE PROCESS
            Set sqlRS = New ADODB.Recordset
            sqlRS.Open "SELECT CRIBTOOLID FROM [TOOLLIST MISC] WHERE PROCESSID =" + Str(ProcessID), sqlConn, adOpenKeyset, adLockReadOnly
            IsStillInToolList = False
            While Not sqlRS.EOF
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = sqlRS.Fields("CRIBTOOLID") Then
                    IsStillInToolList = True
                End If
                sqlRS.MoveNext
            Wend
            sqlRS.Close
            sqlRS.Open "SELECT CRIBTOOLID FROM [TOOLLIST FIXTURE] WHERE PROCESSID =" + Str(ProcessID), sqlConn, adOpenKeyset, adLockReadOnly
            While Not sqlRS.EOF
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = sqlRS.Fields("CRIBTOOLID") Then
                    IsStillInToolList = True
                End If
                sqlRS.MoveNext
            Wend
            sqlRS.Close
            sqlRS.Open "SELECT CRIBTOOLID FROM [TOOLLIST ITEM] WHERE PROCESSID =" + Str(ProcessID), sqlConn, adOpenKeyset, adLockReadOnly
            While Not sqlRS.EOF
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = sqlRS.Fields("CRIBTOOLID") Then
                    IsStillInToolList = True
                End If
                sqlRS.MoveNext
            Wend
            sqlRS.Close
            If Not InOriginalToolList And IsStillInToolList And Not IsDuplicate Then
                i = i + 1
            Else
                CreateRouting.ToolingChangeList.ListItems.Remove (i)
            End If
        Case "USAGE CHANGE"
            j = 0
            'CHECK IF ADDED TOOL IS A DUPLICATE
            IsDuplicate = False
            k = 1
            While k <= CreateRouting.ToolingChangeList.ListItems.Count
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = CreateRouting.ToolingChangeList.ListItems.Item(k).Text And i <> k Then
                    IsDuplicate = True
                End If
                k = k + 1
            Wend
            'CHECK IF USAGE TOOL STILL EXISTS IN THE PROCESS
            Set sqlRS = New ADODB.Recordset
            sqlRS.Open "SELECT CRIBTOOLID FROM [TOOLLIST ITEM] WHERE PROCESSID =" + Str(ProcessID), sqlConn, adOpenKeyset, adLockReadOnly
            IsStillInToolList = False
            While Not sqlRS.EOF
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = sqlRS.Fields("CRIBTOOLID") Then
                    IsStillInToolList = True
                End If
                sqlRS.MoveNext
            Wend
            sqlRS.Close
            If IsStillInToolList And Not IsDuplicate Then
                i = i + 1
            Else
                CreateRouting.ToolingChangeList.ListItems.Remove (i)
            End If
        Case "STOCK TOOLBOSS"
            j = 0
            'CHECK IF ADDED TOOL IS A DUPLICATE
            IsDuplicate = False
            k = 1
            While k <= CreateRouting.ToolingChangeList.ListItems.Count
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = CreateRouting.ToolingChangeList.ListItems.Item(k).Text And i <> k And CreateRouting.ToolingChangeList.ListItems.Item(i).SubItems(2) = CreateRouting.ToolingChangeList.ListItems.Item(k).SubItems(2) Then
                    IsDuplicate = True
                End If
                k = k + 1
            Wend
            'CHECK IF TOOL IS STILL MARKED FOR STOCKING AND IS STILL IN TOOL LIST(COULD OF BEEN DELETED AFTER THE THE STOCK WAS CHECKED)
            Set sqlRS = New ADODB.Recordset
            sqlRS.Open "SELECT CRIBTOOLID FROM [TOOLLIST ITEM] WHERE PROCESSID =" + Str(ProcessID) + " AND TOOLBOSSSTOCK = 1", sqlConn, adOpenKeyset, adLockReadOnly
            IsStillInToolList = False
            While Not sqlRS.EOF
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = sqlRS.Fields("CRIBTOOLID") Then
                    IsStillInToolList = True
                End If
                sqlRS.MoveNext
            Wend
            sqlRS.Close
            sqlRS.Open "SELECT CRIBTOOLID FROM [TOOLLIST FIXTURE] WHERE PROCESSID =" + Str(ProcessID) + " AND TOOLBOSSSTOCK = 1", sqlConn, adOpenKeyset, adLockReadOnly
            While Not sqlRS.EOF
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = sqlRS.Fields("CRIBTOOLID") Then
                    IsStillInToolList = True
                End If
                sqlRS.MoveNext
            Wend
            sqlRS.Close
            sqlRS.Open "SELECT CRIBTOOLID FROM [TOOLLIST MISC] WHERE PROCESSID =" + Str(ProcessID) + " AND TOOLBOSSSTOCK = 1", sqlConn, adOpenKeyset, adLockReadOnly
            While Not sqlRS.EOF
                If CreateRouting.ToolingChangeList.ListItems.Item(i).Text = sqlRS.Fields("CRIBTOOLID") Then
                    IsStillInToolList = True
                End If
                sqlRS.MoveNext
            Wend
            sqlRS.Close
            If IsStillInToolList And Not IsDuplicate Then
                i = i + 1
            Else
                CreateRouting.ToolingChangeList.ListItems.Remove (i)
                
            End If
        Case "PICTURE CHANGE"
            Dim strItemId As String
            strItemId = CreateRouting.ToolingChangeList.ListItems.Item(i).SubItems(6)
'            CreateRouting.ToolingChangeList.ListItems.Item(i).SubItems(3) = ""
            Set sqlRS = New ADODB.Recordset
            sqlRS.Open "SELECT ItemImage FROM [TOOLLIST ITEM] WHERE ItemId =" + strItemId, sqlConn, adOpenKeyset, adLockReadOnly
        
            ' If there was no picture originally and none has been added then remove this tool change
            If colItemImages.Item(strItemId) = "F" And IsNull(sqlRS.Fields("ItemImage")) Then
                CreateRouting.ToolingChangeList.ListItems.Remove (i)
            Else
                 i = i + 1
            End If
            sqlRS.Close
            Set sqlRS = Nothing
        Case Else
            i = i + 1
        End Select
    Wend
End Sub