mprija
06-16-2006, 01:57 AM
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
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