[COLOR=#ff0000]Sub Step1()[/COLOR]
'Encompasses Step1 as per Takalsky's outline
'this procedure determines Airway Bill, sorting the AWB based on length
ActiveWorkbook.Sheets("HazShipper").Select
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim mycell As Range
For Each mycell In Range("E2", Range("E" & Rows.Count).End(xlUp))
If Len(mycell) = 14 Then mycell.Offset(, 16).Value = Right(mycell.Value, 8)
If Len(mycell) = 21 Then mycell.Offset(, 16).Value = "UPS"
If Len(mycell) = 22 Then mycell.Offset(, 16).Value = "UPS"
If Len(mycell) <= 7 Then mycell.Offset(, 16).Value = "Analyze"
If Len(mycell) = 9 Then mycell.Offset(, 16).Value = "Unknown"
If Len(mycell) >= 23 Then mycell.Offset(, 16).Value = "Analyze"
Next mycell
'this procedure extracts the AWB based on CASE. Primarily looks at 3rd Party shippers and not the AWB#
For Each mycell In Range("E2", Range("E" & Rows.Count).End(xlUp))
Select Case True
Case Left(mycell.Value, 2) = "06"
If IsNumeric(Right(mycell.Value, 8)) Then
mycell.Offset(, 16).Value = Right(mycell.Value, 8)
End If
Case UCase(mycell.Value) Like "1Z*" Or mycell.Value Like "UPS*"
mycell.Offset(, 16).Value = "UPS"
Case mycell.Value Like "*FED*" Or mycell.Value Like "FEDEX"
mycell.Offset(, 16).Value = "FEDEX"
Case mycell.Value Like "*DHL*"
mycell.Offset(, 16).Value = "DHL"
Case mycell.Value Like "EXPO*"
mycell.Offset(, 16).Value = "EXPO"
Case mycell.Value Like "STERL*"
mycell.Offset(, 16).Value = "STERLING"
Case UCase(mycell.Value) Like "CHART*"
mycell.Offset(, 16).Value = "CHARTER"
Case mycell.Value Like "*TRUCK*"
mycell.Offset(, 16).Value = "TRUCK"
Case mycell.Value Like "*-*"
mycell.Offset(, 16).Value = "Analyze"
End Select
Next mycell
'this procedure locates the blank cells and inputs "research". Also dresses up the column.
Dim Usdrws As Long
Usdrws = Cells.Find("*", after:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
Range("U2:U" & Usdrws).SpecialCells(xlBlanks).Value = "Analyze"
Range("U1").Select
ActiveCell.FormulaR1C1 = "Actual Airway Bill #"
Selection.Font.Bold = True
Columns("U:U").Select
Selection.ColumnWidth = 11.14
Columns("U:U").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Range("V2").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
[COLOR=#ff0000]Sub Step2()[/COLOR]
'THIS SUB: Pulls the Airport code from the original Airway Bill
ActiveWorkbook.Sheets("HazShipper").Select
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim mycell As Range
For Each mycell In Range("E2", Range("E" & Rows.Count).End(xlUp))
Select Case True
Case UCase(mycell.Value) Like "*ATL*"
mycell.Offset(, 17).Value = "ATG"
Case UCase(mycell.Value) Like "*MSP*"
mycell.Offset(, 17).Value = "MSP"
Case UCase(mycell.Value) Like "*DTW*"
mycell.Offset(, 17).Value = "DTW"
Case mycell.Value = ""
mycell.Offset(, 17).Value = "No AWB"
Case Else
mycell.Offset(, 17).Value = "N/A"
End Select
Next mycell
Range("V1").Select
ActiveCell.FormulaR1C1 = "AWB Airport Code"
Selection.Font.Bold = True
Columns("V:V").Select
Columns("V:V").EntireColumn.AutoFit
With Selection
.HorizontalAlignment = xlCenter
End With
'THIS SUB: Compares data in Column A with column V. If column V is *LIKE* column A then TRUE.
Range("T2").Select
ActiveCell.FormulaR1C1 = "=TRIM(CLEAN(RC[-19]))"
Range("T2").Select
Selection.AutoFill Destination:=Range("T2:T25000")
Range("T2:T25000").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("T1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Column A Values"
Range("T1").Select
Selection.Font.Bold = True
With Selection
.WrapText = True
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Columns("T:T").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Dim myrange As Range
For Each myrange In Range("A2", Range("A" & Rows.Count).End(xlUp))
Select Case UCase(Left(myrange.Offset(, 21), 3))
Case "ATG"
If myrange.Value Like "AT*" Then
myrange.Offset(, 22).Value = "True"
Else
myrange.Offset(, 22).Value = "False"
End If
Case "MSP"
If myrange.Value Like "MSP*" Then
myrange.Offset(, 22).Value = "True"
Else
myrange.Offset(, 22).Value = "False"
End If
Case "DTW"
If myrange.Value Like "DTW*" Then
myrange.Offset(, 22).Value = "True"
Else
myrange.Offset(, 22).Value = "False"
End If
Case "N/A"
If myrange.Offset(, 21).Value Like "N/A" Then
myrange.Offset(, 22).Value = "N/A"
Else
myrange.Offset(, 22).Value = "False"
End If
Case Else
myrange.Offset(, 22).Value = "No AWB"
End Select
Next myrange
Range("W1").Select
ActiveCell.FormulaR1C1 = "AWB Airport Match Column A?"
Selection.Font.Bold = True
Columns("W:W").Select
Columns("W:W").EntireColumn.AutoFit
With Selection
.HorizontalAlignment = xlCenter
End With
Range("X2").Select
Columns("T:T").ColumnWidth = 10.14
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
[COLOR=#ff0000]Sub Step3()[/COLOR]
'THIS SUB: Compares the first 5 characters in Column J(designated by the macro) with Column A.
Dim Usdrws As Long
ActiveWorkbook.Sheets("HazShipper").Select
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Usdrws = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
Range("X2").Value = "=TRIM(CLEAN(J2))"
Range("X2").Select
Selection.AutoFill Destination:=Range("X2:X" & Usdrws)
Dim myrange As Range
For Each myrange In Range("A2", Range("A" & Rows.Count).End(xlUp))
Select Case UCase(Left(myrange.Offset(, 9), 5))
Case "MINNE"
If myrange.Value Like "*MSP*" Then
myrange.Offset(, 24) = "True"
End If
Case "ST.PA"
If myrange.Value Like "*MSP*" Then
myrange.Offset(, 24) = "True"
End If
Case "ATLAN"
If myrange.Value Like "AT*" Then
myrange.Offset(, 24) = "True"
End If
Case "DETRO"
If myrange.Value Like "DTW*" Then
myrange.Offset(, 24) = "True"
End If
Case ""
If myrange.Offset(, 9).Value = "" Then
myrange.Offset(, 24) = "No Departure"
End If
Case Else
myrange.Offset(, 24) = "False"
End Select
Next
Range("X1").Select
ActiveCell.FormulaR1C1 = "Departure Airport"
Range("Y1").Select
ActiveCell.FormulaR1C1 = "Departure Match Column A"
Range("X1:Y1").Select
Selection.Font.Bold = True
Columns("X:Y").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Columns("X:Y").EntireColumn.AutoFit
Range("X1").Select
With Selection.Interior
.Color = 65535
End With
Range("Z2").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
[COLOR=#ff0000]Sub Step4()[/COLOR]
'sub looks compares destination to customer ID, TRUE if match, false if no match
Dim Usdrws As Long
ActiveWorkbook.Sheets("HazShipper").Select
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Usdrws = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
Range("Z2").Value = "=LEFT(TRIM(CLEAN(Q2)),3)"
Range("AA2").Value = "=TRIM(CLEAN(K2))"
Range("AB2").Value = "=IFNA(VLOOKUP(Z2,AirportCodes!$A$2:$C$2000,2,0),""No Departure"")"
Range("AC2").Value = "=IF(LEFT(K2,4)=LEFT(AB2,4),True,False)"
Range("Z2:AC2").Select
Selection.AutoFill Destination:=Range("Z2:AC2" & Usdrws)
Range("Z1").Select
ActiveCell.FormulaR1C1 = "Customer ID"
Range("AA1").Select
ActiveCell.FormulaR1C1 = "HazShipper Destination"
Range("AB1").Select
ActiveCell.FormulaR1C1 = "Airport Code Destination"
Range("AC1").Select
ActiveCell.FormulaR1C1 = "Dest. Match?"
Range("Z1:AC1").Select
Selection.Font.Bold = True
Range("Z1,AA1").Select
With Selection.Interior
.Color = 65535
End With
Columns("Z:Z").ColumnWidth = 8.86
Columns("AA:AC").EntireColumn.AutoFit
Columns("Z:AC").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Columns("AC:AC").ColumnWidth = 6.86
Range("AD2").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub