Dim filex As String
Public NumofTravPositions As Integer
Public NumofFlowDays As Integer
Public FlowDay As Integer
Public TravelersByPos(1 To 6, 1 To 4, 1 To 30) As Integer 'An array which holds CCs that are traveling at each position after leaving the originating shop
Public LNPosition(1 To 6) As Integer 'This array holds ACTUAL line numbers at each position based on the current schedule
Public jobcount As Integer
Public noUpdate As Boolean
Public AddLNContinue As Boolean
Sub InitializeProgram()
'This will make sure the program is initialized correctly
Worksheets("Travelers").Visible = True
Range("JobData").ClearContents 'Clear traveling jobs list on the first sheet
End Sub
Sub Rectangle_click()
frmUpdate.Show
End Sub
Sub ImportData()
Application.ScreenUpdating = False
'Count Jobs (Erase two to account for text in column)
Sheets("TMC Report").Select
jobcount = Application.CountA(Range(Range("TableStart"), Range("TableStart").Offset(1000, 0))) - 3
'Convert Text to Numbers - This is used to account for times when TMC data gets imported as text (precaution)
Range(Range("TableStart"), Range("TableStart").Offset(jobcount - 1, 2)).Value = Range(Range("TableStart"), Range("TableStart").Offset(jobcount - 1, 2)).Value
'Sort Data by Line followed by CC
' Range(Range("TableStart"), Range("TableLastCol").Offset(jobcount - 1, 0)).Select
' Selection.Sort Key1:=Range("B44"), Order1:=xlAscending, Key2:=Range("C44" _
), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
'Sort Data by Line followed by CC
'E1=Position D1=CC B1=LN C1=Shop I1=Desc
'SORT BY DESCRIPTION
Range(Range("TableStart"), Range("TableLastCol").Offset(jobcount - 1, 0)).Sort _
Key1:=Range("D50"), Order1:=xlAscending _
, Key2:=Range("E50"), Order2:=xlDescending
'CUSTOM SORT OF CC BY SHOP WORK ORDER (WINGS,HORIZ STAB,VERT FIN,OVERWING FRG,AFT,TEFLON,STUB,GEAR,FWD,AFT,MID)
Application.AddCustomList ListArray:=Array( _
"805", "730", _
"780", "512", "520", _
"742", "543", _
"334", "785", "798", _
"314", _
"818", _
"338", _
"138", _
"315", "316", "823", "741", _
"820", "746", _
"826", "744", _
"128", "840", "131", "121")
customListNum = Application.GetCustomListNum(Array("805", "730", "780", "512", "520", "742", "543", _
"334", "785", "798", "314", "818", "338", "138", "315", "316", "823", "741", "820", "746", "826", "744", _
"128", "840", "131", "121"))
Range(Range("TableStart"), Range("TableLastCol").Offset(jobcount - 1, 0)).Sort Key1:=Range("C50"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=customListNum + 1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.DeleteCustomList customListNum
'END OF CUSTOM SORT
'SORT BY LN
Range(Range("TableStart"), Range("TableLastCol").Offset(jobcount - 1, 0)).Sort _
Key1:=Range("B50"), Order1:=xlAscending
'ALGORITHM TO MOVE NCRS BEFORE RELATED IP
'This goes through the TMC report and finds the IP related to each NCR, then moves
'the NCR under its respective IP (if no related IP, it will not be moved)
'Search for NCRs in Working Traveler Report
'Variables
Dim RelatedIP As String, WorkingCurrentIP As String, WorkingNCR As String 'These are used for NCR comparisons
h = 0
Do While Range("TableStart").Offset(h, 0) <> ""
Range("TableStart").Offset(h, 0).EntireRow.Name = "NCRRange"
WorkingNCR = Range("TableStart").Offset(h, 4)
Range("TableStart").Offset(h, 4).Select
'Check if is a NCR and Search for "Related IP" in TMC Report
If Mid(WorkingNCR, 9, 1) = "N" Then
RelatedIP = Range("TableStart").Offset(h, 6)
z = 0
Do While Range("TableStart").Offset(z, 0) <> ""
WorkingCurrentIP = Range("TableStart").Offset(z, 4)
'Cut Cells When Find "Related IP" is the same and line numebers are the same
If CompareStrings(RelatedIP, WorkingCurrentIP) _
And Range("TableStart").Offset(h, 1) = Range("TableStart").Offset(z, 1) Then
'MsgBox TruncateWorkingCurrentIP
If Range("NCRRange").Row <> Range("TableStart").Offset(z + 1, 0).Row Then
Range("NCRRange").Cut
Range("TableStart").Offset(z + 1, 0).EntireRow.Select
Selection.Insert Shift:=xlDown
'Adjust for added row
If z >= h Then
h = h - 1
End If
End If
'Exit if NCR Found
Exit Do
End If
z = z + 1
Loop
End If
h = h + 1
Loop
'END SORT NCR ALGORITHM
CreateNewReport
End Sub
Function CompareStrings(String1 As String, String2 As String) As Boolean
'Function returns true if strings are the same or false if not
Dim cString(1 To 2), TruncateString(1 To 2) As String
cString(1) = String1
cString(2) = String2
'Truncate if necessary (to get rid of spaces at end of string - for fair comparison)
For i = 1 To 2
If cString(i) <> "" Then
If Mid(cString(i), Len(cString(i)), 1) = " " Then
TruncateString(i) = Left(cString(i), Len(cString(i)) - 1)
Else
TruncateString(i) = cString(i)
End If
End If
Next i
'Check If Strings Are the Same
If UCase(TruncateString(1)) = UCase(TruncateString(2)) Then
CompareStrings = True
Else
CompareStrings = False
End If
End Function
Sub CreateNewReport()
Dim i, v As Integer
Dim cLineNumber As Integer 'Holds the current AP line number being "worked" on
Dim oldLineNumber As Integer ''Holds the previous AP line number being "worked" on
Dim CurrentLine As Integer 'Holds the current excel row numbers as the sheets is populated
Dim LNJobCount As Integer 'Holds the count of jobs on the current LN
Dim cPosition As Integer 'Holds the position of the Line Number (=0 when plane in factory, but out of position and -1 if plane is
Dim Traveler As Integer 'Value of indicates job is traveler, 0 not traveler
Dim CurrentIP As String 'Holds the IP being copied
Dim WorkingCurrentIP As String 'Holds the IP being compared from the "workingtravelerreport"
Dim r As Integer
Dim CountTrigger As String 'Used to check for start condition of heading loop
Dim TMCNCR As String, WorkingNCR As String 'These are used for NCR comparisons
Dim planeposition As Integer 'Holds the row number for updating status on the "travelers" sheet
Dim Position As String 'Holds the string that describes plane position - for example "FA","FBJ", etc.
Application.ScreenUpdating = False
Range("LastFlowDay") = FlowDay
'Clear Old Data NOTE: 1000 is default row length- what if traveler report grows larger?
Sheets("WorkingTravelerReport").Select
Rows("1:1000").Select
Selection.Delete Shift:=xlUp
Sheets("TMC Report").Select
'Start Values
oldLineNumber = 0
CurrentLine = 0
LNJobCount = 0
'Loop to go through lines
For i = 0 To jobcount - 1
cLineNumber = Range("TableStart").Offset(i, 1).Value
'Check if traveler routine and Check if RO or MH
'Initial Values
JobCC = 0
LastCC = 818 'SET TO BE FIRST CONTROL CODE TO TRAVEL IF CC NOT FOUND IN CCTABLE
Traveler = -1
'Check if RO or MH
Sheets("TMC Report").Select
If Range("TableStart").Offset(i, 5) <> "RO" And Range("TableStart").Offset(i, 5) <> "MH" And Range("TableStart").Offset(i, 5) <> "CO" Then
'Check if Traveler
'FIND THE LAST CC
'-----------------------------------------------------------------------------------
'Write CC
JobCC = Range("TableStart").Offset(i, 2)
'Get Last CC
t = 0
u = 0
Do
t = t + 1
Do
u = u + 1
Loop While Sheets("CCTable").Range("A1").Offset(t, u) <> JobCC _
And Sheets("CCTable").Range("A1").Offset(t, u) <> ""
If Sheets("CCTable").Range("A1").Offset(t, u) = JobCC Then
LastCC = Sheets("CCTable").Range("A1").Offset(t, 0)
Exit Do
End If
u = 0
Loop While Sheets("CCTable").Range("A1").Offset(t, 0) <> ""
'-----------------------------------------------------------------------------------
'FIND IF TRAVELER OR NOT BASED ON DATE
'-----------------------------------------------------------------------------------
'Find Line Number in Table
t = 1
Do While Sheets("ScheduleTable").Range("C2").Offset(t, 0) <> "" _
And Sheets("ScheduleTable").Range("C2").Offset(t, 0) <> cLineNumber
t = t + 1
Loop
'Find correct CC in Table
u = 1
Do While Sheets("ScheduleTable").Range("C2").Offset(0, u) <> "" _
And Sheets("ScheduleTable").Range("C2").Offset(0, u) <> LastCC
u = u + 1
Loop
'Traveler or Not
If Date > Sheets("ScheduleTable").Range("C2").Offset(t, u) _
And Sheets("ScheduleTable").Range("C2").Offset(0, u) <> "" Then
Traveler = 1
End If
'-----------------------------------------------------------------------------------
'Add Job to List (If traveler)
If Traveler = 1 Then
'Headings
If cLineNumber <> oldLineNumber Then
Sheets("WorkingTravelerReport").Select
If oldLineNumber = 0 Then
CurrentLine = CurrentLine + 2
Else
AddHeadings CurrentLine, LNJobCount, oldLineNumber
CurrentLine = CurrentLine + 5
End If
Sheets("WorkingTravelerReport").Select
Range("C1").Offset(CurrentLine - 1, 0).Value = cLineNumber
oldLineNumber = cLineNumber
LNJobCount = 0
Sheets("WorkingTravelerReport").Select
Range(Range("A1").Offset(CurrentLine - 2, 0), Range("K1").Offset(CurrentLine - 2, 0)).Interior.ColorIndex = 15
End If
Sheets("TMC Report").Select
LNJobCount = LNJobCount + 1
Range(Range("TableStart").Offset(i, 2), Range("TableStart").Offset(i, 4)).Select
Selection.Copy
Sheets("WorkingTravelerReport").Select
Range("D1").Offset(CurrentLine, 0).Select
ActiveSheet.Paste
Sheets("TMC Report").Select
Range("TableStart").Offset(i, 7).Select
Selection.Copy
Sheets("WorkingTravelerReport").Select
Range("G1").Offset(CurrentLine, 0).Select
ActiveSheet.Paste
'Add Shift To Report
Sheets("TMC Report").Select
Range("TableStart").Offset(i, 9).Select
Selection.Copy
Sheets("WorkingTravelerReport").Select
Range("C1").Offset(CurrentLine, 0).Select
ActiveSheet.Paste
Selection.Value = Selection.Value
'Add Crew Bar Line To Report
Sheets("TMC Report").Select
Range("TableStart").Offset(i, 10).Select
Selection.Copy
Sheets("WorkingTravelerReport").Select
Range("B1").Offset(CurrentLine, 0).Select
ActiveSheet.Paste
Selection.Value = Selection.Value
CurrentIP = Range("F1").Offset(CurrentLine, 0).Value
'Check for and copy previous report comments
Sheets("Travelers").Select
For q = 1 To 1000
r = 1
If Range("LineNumber").Offset(q, 0) = cLineNumber Then
Do While Len(Range("JOB").Offset(q + r).Text) >= 10 'CHANGED TO TRY TO FIX DELETING ERROR
WorkingCurrentIP = Range("JOB").Offset(q + r).Value
If CompareStrings(WorkingCurrentIP, CurrentIP) Then
Range(Range("ECD").Offset(q + r), Range("Comments").Offset(q + r)).Copy
Sheets("WorkingTravelerReport").Select
Range("H1").Offset(CurrentLine, 0).Select
ActiveSheet.Paste
End If
r = r + 1
Loop
End If
Next q
'NEW CODE TO INSERT "RFI" WHEN SHOWN IN TMC
If UCase(Left(Sheets("WorkingTravelerReport").Range("I1").Offset(CurrentLine, 0).Text, 3)) = "RFI" Then
If Left(Range("TableStart").Offset(i, 13).Text, 3) <> "RFI" Then
Sheets("WorkingTravelerReport").Range("I1").Offset(CurrentLine, 0) = ""
End If
Else
If Left(Range("TableStart").Offset(i, 13).Text, 3) = "RFI" Then
Sheets("WorkingTravelerReport").Range("I1").Offset(CurrentLine, 0) = "RFI"
End If
End If
'NEW CODE TO ADD COMMENTS TO JOB WHEN THEY ARE IN TMC
If Range("TableStart").Offset(i, 16) <> "" Then
'Sheets("WorkingTravelerReport").Range("F1").Offset(CurrentLine, 0).ClearComments
Sheets("WorkingTravelerReport").Range("F1").Offset(CurrentLine, 0).AddComment
Sheets("WorkingTravelerReport").Range("F1").Offset(CurrentLine, 0).Comment.Text Text:=Range("TableStart").Offset(i, 16).Text
Else
Sheets("WorkingTravelerReport").Range("F1").Offset(CurrentLine, 0).ClearComments
End If
'Make sure lines don't "overflow"
Sheets("WorkingTravelerReport").Select
If Range("H1").Offset(CurrentLine, 0) = "" Then
Range("H1").Offset(CurrentLine, 0) = " "
End If
'Advance to next line
Sheets("WorkingTravelerReport").Select
CurrentLine = CurrentLine + 1
End If
End If
Next i
AddHeadings CurrentLine, LNJobCount, oldLineNumber
'FORMATTING
Sheets("WorkingTravelerReport").Select
With Range(Range("A1"), Range("K1").Offset(CurrentLine + 1, 0))
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
'Transfer new report over old report
Sheets("Travelers").Select
'Delete Assumes Less Than 1000 Jobs Long
Rows("25:1025").Delete Shift:=xlUp
Sheets("WorkingTravelerReport").Select
Rows("1:1001").Copy
Sheets("Travelers").Select
Range("A25").EntireRow.Insert Shift:=xlDown
'Update Airplane Display
If noUpdate = False Then
Range("BehindSchedule").QueryTable.Refresh BackgroundQuery:=False
Range("yStatus").Value = Range("tStatus").Value
Range("tStatus").Value = Range("BehindSchedule").Offset(Application.Count(Range(Range("BehindSchedule"), Range("BehindSchedule").Offset(1000, 0))), 0).Value
End If
'Set Print Area
ActiveSheet.PageSetup.PrintArea = ""
Range("A1").Select
Application.ScreenUpdating = True
End Sub