Solved: Help! - copy rows based on column criteria

[mprija]

I wrote macro which makes 4 new worksheets (AU - LH, AU - UA, AU - OS and AU - SK) and copies first row from Worksheet FARES to all newly made worksheets. But now I do not know how to copy other rows based on collum A1 criteria to newly made worksheets, this other rows should be pasted on new worksheets below first line. For example I need to COPY rows which have in collum A1: GTW, FCO, VIE to worksheet AU - LH; CDG and MXP to worksheet AU - UA; LJU and MXP to worksheet AU - OS, and FCO to worksheet AU - SK. If anyone can offer help I would be grateful.


Here is code my code which makes worksheets and copies first row.

Sub CopyDataToNewWorksheets()
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "AU - LH" ' Add worksheet AU - LH.
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "AU - UA" ' Add worksheet AU - UA.
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "AU - OS" ' Add worksheet AU - OS.
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "AU - SK" ' Add worksheet AU - SK.
Sheets("FARES").Select ' Select worksheet FARES
Rows("1:1").Select ' Select first row
Selection.Copy ' Copy first row
Sheets("AU - LH").Select ' Select worksheet AU - LH
ActiveSheet.Paste ' Paste copied row
Sheets("AU - UA").Select ' Select worksheet AU - UA
ActiveSheet.Paste ' Paste copied row
Sheets("AU - OS").Select ' Select worksheet AU - OS
ActiveSheet.Paste ' Paste copied row
Sheets("AU - SK").Select ' Select worksheet AU - SK
ActiveSheet.Paste ' Paste copied row
Sheets("FARES").Select ' Select worksheet FARES
End Sub

[mvidas]

Hi mprija,

First off, just to let you know you listed "FCO" and "MXP" twice, once for "AU - UA", and another for "AU - OS". But you should be able to see how to change it in my code here to what you meant to list, I hope I've commented it enough for you. If you intended this, and want the rows copied to both sheets, let me know and I can modify it accordingly. Please don't hesitate to ask anyone here if you have any questions!Sub CopyDataToNewWorksheets()
Dim CLL As Range, FaresWS As Worksheet, DestWS As Worksheet

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

'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 - SK"
Worksheets.Add(After:=FaresWS).Name = "AU - OS"
Worksheets.Add(After:=FaresWS).Name = "AU - UA"
Worksheets.Add(After:=FaresWS).Name = "AU - LH"

'Copy header row from FARES to each of the new worksheets
With FaresWS.Rows(1)
.Copy Sheets("AU - LH").Rows(1) ' Paste to worksheet AU - LH
.Copy Sheets("AU - UA").Rows(1) ' Paste to worksheet AU - UA
.Copy Sheets("AU - OS").Rows(1) ' Paste to worksheet AU - OS
.Copy Sheets("AU - SK").Rows(1) ' Paste to worksheet AU - SK
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
Select Case Trim(UCase(CLL.Text))
Case "GTW", "FCO", "VIE": Set DestWS = Sheets("AU - LH")
Case "CDG", "MXP": Set DestWS = Sheets("AU - UA")
Case "LJU", "MXP": Set DestWS = Sheets("AU - OS")
Case "FCO": Set DestWS = Sheets("AU - SK")
Case Else: Set DestWS = Nothing
End Select

'Copy data row to destination sheet if it exists
If Not DestWS Is Nothing Then
CLL.EntireRow.Copy DestWS.Rows(DestWS.UsedRange.Rows.Count + 1)
End If

Next 'CLL

'Turn ScreenUpdating back on
Application.ScreenUpdating = True

'Release memory reserved for variables
Set CLL = Nothing
Set FaresWS = Nothing
Set DestWS = Nothing
End SubMatt

[mvidas]

If you did want FCO and MXP to be copied to multiple sheets (or if the need ever arises in the future), I'll show you what you would need to change. I'll set DestWS as the first destination sheet, copy the row, then set DestWS as the second destination sheet so that the normal copying procedure will still go through: 'Examine cell text, set destination worksheet accordingly
Select Case Trim(UCase(CLL.Text))
Case "FCO"
Set DestWS = Sheets("AU - LH")
CLL.EntireRow.Copy DestWS.Rows(DestWS.UsedRange.Rows.Count + 1)
Set DestWS = Sheets("AU - SK")
Case "MXP"
Set DestWS = Sheets("AU - UA")
CLL.EntireRow.Copy DestWS.Rows(DestWS.UsedRange.Rows.Count + 1)
Set DestWS = Sheets("AU - OS")
Case "GTW", "VIE": Set DestWS = Sheets("AU - LH")
Case "CDG": Set DestWS = Sheets("AU - UA")
Case "LJU": Set DestWS = Sheets("AU - OS")
Case Else: Set DestWS = Nothing
End SelectMatt

[mprija]

:clap: Thank u Matt :clap:, your code solved big problem for me. Yes I wanted that both FCO and MXP are copied to multiple sheets. Now I have another problem in pricelist on which I want to use this macro I have in some cells in first colum multiple airports in string separated with separator "/" (for example PLQ/RIX/TLL). Now I need to copy only PLQ and RIX to sheet AU - LH, and RIX and TLL to sheet AU - UA. So actually I need to tell to excel that it will not copy all content from first cell but only PLQ/RIX to AU - LH sheet and RIX/TLL to AU - UA. At same time it also needs to copy rest of row with right prices to both sheets AU - UA and AU - LH. I have uploaded file and where it is possible to see more clearly what I would like that code will do for me. Here is code which i have at the moment.

Sub CopyDataToNewWorksheets()
Dim CLL As Range, FaresWS As Worksheet, DestWS As Worksheet

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

'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 - SK"
Worksheets.Add(After:=FaresWS).Name = "AU - OS"
Worksheets.Add(After:=FaresWS).Name = "AU - UA"
Worksheets.Add(After:=FaresWS).Name = "AU - LH"

'Copy header row from FARES to each of the new worksheets
With FaresWS.Rows(1)
.Copy Sheets("AU - LH").Rows(1) ' Paste to worksheet AU - LH
.Copy Sheets("AU - UA").Rows(1) ' Paste to worksheet AU - UA
.Copy Sheets("AU - OS").Rows(1) ' Paste to worksheet AU - OS
.Copy Sheets("AU - SK").Rows(1) ' Paste to worksheet AU - SK
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
Select Case Trim(UCase(CLL.Text))
Case "FCO"
Set DestWS = Sheets("AU - LH")
CLL.EntireRow.Copy DestWS.Rows(DestWS.UsedRange.Rows.Count + 1)
Set DestWS = Sheets("AU - SK")
Case "MXP"
Set DestWS = Sheets("AU - UA")
CLL.EntireRow.Copy DestWS.Rows(DestWS.UsedRange.Rows.Count + 1)
Set DestWS = Sheets("AU - OS")
Case "GTW", "VIE": Set DestWS = Sheets("AU - LH")
Case "CDG": Set DestWS = Sheets("AU - UA")
Case "LJU": Set DestWS = Sheets("AU - OS")
Case Else: Set DestWS = Nothing
End Select

'Copy data row to destination sheet if it exists
If Not DestWS Is Nothing Then
CLL.EntireRow.Copy DestWS.Rows(DestWS.UsedRange.Rows.Count + 1)
End If

Next 'CLL

'Turn ScreenUpdating back on
Application.ScreenUpdating = True

'Release memory reserved for variables
Set CLL = Nothing
Set FaresWS = Nothing
Set DestWS = Nothing
End Sub
Matt maybe you can help, or somebody else? I would be grateful.

[mvidas]

Hello,

I took a look through there, and it would be possible to do, though I'm wondering how you want the macro to decide what to copy. I can code it to split just PLQ/RIX/TLL and copy those lines to the appropriate sheets, but I'd like to program it a little smarter. How should the macro know which airports to move and how to split them up? Will PLQ, RIX, TLL be added to that Select Case statement, so that PLQ and RIX are listed for AU - LH, and RIX and TLL be added to AU - UA ?

Also, do you want them moved like in your example (using commas to denote different columns):
PLQ/RIX,,,420,400,400

Or would you also like them split up?
PLQ,,,420,400,400
RIX,,,420,400,400

I will likely be changing the way I wrote the macro depending on what you're ultimately looking for, I just want to make sure I have all the information I can so I can determine the best way to write it.
Let me know!
Matt

[mprija]

Thank you Matt for fast reply and sorry for my slow reply, I had some problems with my computer but now it is fixed.

First of all I would like to explain why I need macro which will copy data and copy into appropriate sheets. I am getting pricelists from airline alliances, they are sending joint pricelists, for example United, Lufthansa, Scandinavian and Ostrian airlines, in one pricelist. There are prices for combinations of airports from US to EUROPE, ASIA,... Airport codes are 3 letter codes for example JFK (New York), CDG (Paris),..., if price is same for two or more arrival airports then airports are written in same cell separated by separator (,) or (/) (for example: CDG, LHR, ARN or CDG/LHR/ARN), the problem is that all four companies (Lufthansa, United, Scandinavian and Ostrian) do not fly to all destinations in our case CDG, LHR, ARN. But for example Lufthansa flies to CDG and LHR, United to ARN and CDG and Scandinavian to ARN only. So macro actually needs to copy from original worksheet (FARES) to appropriate worksheets (Lufthansa; AU ? LH, United; AU - UN, AU ? SK; Scandinavian) only arrival airports with appropriate price where to airline fly.

You asked how macro should decide what to copy and where, well I have routings for all this four airlines, so I know which one flies to which destination, I just need some example code which I will be able to extend on all other airports. That is why I sent only small example file because original pricelist file is really big with many airports, and it will take long to write for all combinations.

Your idea about splitting airports and putting each of them into separate row is really good, and it would be really good if macro will split and copy each airport with prices in appropriate sheet:

PLQ,,,420,400,400
RIX,,,420,400,400

I got another idea, as you can see in newly attached file (pricelist.xls), airports which are separated by (,) are in table bellow pricelist itself (EU-1, EU-2,...for EUROPEAN arrival destinations and 10, 20, 30,... for US departure airports), for now I have to manually copy and past this airports from this table to pricelist table. So I am thinking if it is possible that macro would before doing anything else copy airport codes from cell next to 10, 20, 30..... and copy it into right cells in header row of pricelist (UA 10, UA 20, UA 30....) then it would copy airport codes from other table with EUROPEAN airports EU-1, EU-2, EU-3,... to first column to appropriate cells (EU-1, EU-2, EU-3,....).

And last ability which would be good that macro would have is that if airline would decide and add some airports, that macro would maybe copy this new airport codes which do not have routing (which because they would be new would not have defined to which AU sheet they need do be copied) to maybe new sheet (NEW) or maybe mark them somehow maybe color them,? Actually it doesn?t matter most important that they would be stored somewhere so that I would know that they are new and I have to add code for them in macro where to which AU sheet copy them.

I hope I did explain everything enough and that I did not complicate everything too much. In new attachment its original of small pricelist from Star Alliance (UA, LH, OS, SK), to make it clearer on what I kind of data I need to use my macro. If I need to give some more info contact me please, and thanks in advance for al help.

[mvidas]

Ok, I've taken care of the first part by adding a function to check for the airport and move if need be (not the fastest way to do it, but easiest to maintain/add new):

Option Explicit
Sub CopyDataToNewWorksheets()
Dim CLL As Range, FaresWS As Worksheet

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

'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 - SK"
Worksheets.Add(After:=FaresWS).Name = "AU - OS"
Worksheets.Add(After:=FaresWS).Name = "AU - UA"
Worksheets.Add(After:=FaresWS).Name = "AU - LH"

'Copy header row from FARES to each of the new worksheets
With FaresWS.Rows(1)
.Copy Sheets("AU - LH").Rows(1) ' Paste to worksheet AU - LH
.Copy Sheets("AU - UA").Rows(1) ' Paste to worksheet AU - UA
.Copy Sheets("AU - OS").Rows(1) ' Paste to worksheet AU - OS
.Copy Sheets("AU - SK").Rows(1) ' Paste to worksheet AU - SK
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 - LH"), "FCO"
CheckAirport CLL, Sheets("AU - SK"), "FCO"
CheckAirport CLL, Sheets("AU - UA"), "MXP"
CheckAirport CLL, Sheets("AU - OS"), "MXP"
CheckAirport CLL, Sheets("AU - LH"), "GTW"
CheckAirport CLL, Sheets("AU - LH"), "VIE"
CheckAirport CLL, Sheets("AU - UA"), "CDG"
CheckAirport CLL, Sheets("AU - OS"), "LJU"
CheckAirport CLL, Sheets("AU - LH"), "PLQ"
CheckAirport CLL, Sheets("AU - LH"), "RIX"
CheckAirport CLL, Sheets("AU - UA"), "RIX"
CheckAirport CLL, Sheets("AU - UA"), "TLL"

Next 'CLL

'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 FunctionAs for your question about pricelist.xls, I would recommend opening a new question for that. I don't have the time right now to work on that and someone else should be able to do it for you.

Changing the above macro to identify new airports would be real easy if that airport was by itself in a cell, but if it contained multiple airports like FCO/NEW/MXP, it would require a much more involved re-write to find NEW, something I can't do at the moment. I just wanted to give you something to help for the moment, hopefully someone else can step in to help with the rest (or after checking this, perhaps you may have some more ideas of what you want to do--rather than changing the method of the macro). Unfortunately I do have too much work of my own recently to help out too much

[mprija]

Thank u Matt you helped me a lot.