Determine which strings are new and copy them to WS

[mprija]

I have a macro which makes two new WS (AU - UA and AU - LH), copies header row to both of them and then copy three letter airport codes which are in column A with appropriate prices to these new sheets. I need to modify code so if there will be in pricelist some new airport codes which are not in macro yet, that they would be copied to new WS (NEW CODES), so I will know which airports are new. I have attached example file, to make things clearer what kind of result I would like to get after running macro. I will be glad if anyone can offer me help.

Here is code of my macro:

Option Explicit
Sub UA_LH_OS_SK_VER_2()


'Turn off ScreenUpdating for faster runtime so screen won't flash while running
Application.ScreenUpdating = False



Dim CLL As Range, FaresWS As Worksheet

'Set variables
Set FaresWS = Sheets("FARES")

' Add worksheets AU - LH, AU - UA, AU - OS, AU - SK,... after worksheet FARES
Worksheets.Add(After:=FaresWS).Name = "AU - LH"
Worksheets.Add(After:=FaresWS).Name = "AU - UA"

'Copy header row from FARES to each of the new worksheets
With FaresWS.Rows(1)
.Copy Sheets("AU - UA").Rows(1) ' Paste to worksheet AU - UA
.Copy Sheets("AU - LH").Rows(1) ' Paste to worksheet AU - LH

End With

'Look at each used cell in column A of FARES, starting with A2
' examine text in each cell, and set destination worksheet based on cell text
' If there is a destination sheet (valid, non-blank entries), row is copied
For Each CLL In FaresWS.Range("A2", FaresWS.Cells(FaresWS.Rows.Count, 1).End(xlUp))

'Examine cell text, set destination worksheet accordingly
CheckAirport CLL, Sheets("AU - UA"), "CDG"
CheckAirport CLL, Sheets("AU - UA"), "LHR"
CheckAirport CLL, Sheets("AU - LH"), "CDG"
CheckAirport CLL, Sheets("AU - LH"), "FCO"
CheckAirport CLL, Sheets("AU - LH"), "MXP"



Next 'CLL

' Sort all newly created WS
Sheets("AU - UA").Select
Cells.Select
Selection.UnMerge
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Sheets("AU - LH").Select
Cells.Select
Selection.UnMerge
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


'Turn ScreenUpdating back on
Application.ScreenUpdating = True

'Release memory reserved for variables
Set CLL = Nothing
Set FaresWS = Nothing
End Sub
Function CheckAirport(ByVal CLL As Range, ByVal DestWS As Worksheet, _
ByVal vAirport As String) As Boolean
If InStr(1, UCase(CLL.Text), vAirport) > 0 Then
With DestWS
CLL.EntireRow.Copy .Rows(.UsedRange.Rows.Count + 1)
.Cells(.UsedRange.Rows.Count, 1).Value = vAirport
End With
End If
End Function

[mprija]

Sorry guys I see I didnt write clear enough, so let me try to explain what I would like my macro will do. For now my macro copies to worksheets AU - UA and AU - LH following airports CDG and LHR to AU - UA worksheet, CDG, FCO MXP to AU - LH worksheet. This can be seen from code bellow. Problem is if airline adds new airport I do not know about it. So I would like that if there would be some new airport codes in new pricelists which airlines are sending to me (in atached example file this new airport codes are AMS and GTW) that they would be copied to worksheet named NEW CODES, so I would know which airports are new. So macro should if it finds any unknown airport code which is not written in it yet, copy it to sheet NEW CODES. I hope I explained and that now it is clearer what I would like to do.


Option Explicit
Sub UA_LH_OS_SK_VER_2()


'Turn off ScreenUpdating for faster runtime so screen won't flash while running
Application.ScreenUpdating = False



Dim CLL As Range, FaresWS As Worksheet

'Set variables
Set FaresWS = Sheets("FARES")

' Add worksheets AU - LH, AU - UA, NEW AIRPORTS
Worksheets.Add(After:=FaresWS).Name = "AU - LH"
Worksheets.Add(After:=FaresWS).Name = "AU - UA"
Worksheets.Add(After:=FaresWS).Name = "NEW CODES"

'Copy header row from FARES to each of the new worksheets
With FaresWS.Rows(1)
.Copy Sheets("AU - UA").Rows(1) ' Paste to worksheet AU - UA
.Copy Sheets("AU - LH").Rows(1) ' Paste to worksheet AU - LH
.Copy Sheets("NEW CODES").Rows(1) ' Paste to worksheet NEW CODES

End With

'Look at each used cell in column A of FARES, starting with A2
' examine text in each cell, and set destination worksheet based on cell text
' If there is a destination sheet (valid, non-blank entries), row is copied
For Each CLL In FaresWS.Range("A2", FaresWS.Cells(FaresWS.Rows.Count, 1).End(xlUp))

'Examine cell text, set destination worksheet accordingly
CheckAirport CLL, Sheets("AU - UA"), "CDG"
CheckAirport CLL, Sheets("AU - UA"), "LHR"
CheckAirport CLL, Sheets("AU - LH"), "CDG"
CheckAirport CLL, Sheets("AU - LH"), "FCO"
CheckAirport CLL, Sheets("AU - LH"), "MXP"



Next 'CLL

' Sort all newly created WS
Sheets("AU - UA").Select
Cells.Select
Selection.UnMerge
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Sheets("AU - LH").Select
Cells.Select
Selection.UnMerge
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


'Turn ScreenUpdating back on
Application.ScreenUpdating = True

'Release memory reserved for variables
Set CLL = Nothing
Set FaresWS = Nothing
End Sub
Function CheckAirport(ByVal CLL As Range, ByVal DestWS As Worksheet, _
ByVal vAirport As String) As Boolean
If InStr(1, UCase(CLL.Text), vAirport) > 0 Then
With DestWS
CLL.EntireRow.Copy .Rows(.UsedRange.Rows.Count + 1)
.Cells(.UsedRange.Rows.Count, 1).Value = vAirport
End With
End If
End Function