+ Reply to Thread
Results 1 to 3 of 3

Order list with a Macro

  1. #1
    Registered User
    Join Date
    01-03-2018
    Location
    England
    MS-Off Ver
    MSO 2016
    Posts
    5

    Order list with a Macro

    Hi everyone,

    I have following:
    Sub CopyRangeITOFF() Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("IT").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Sheets("IT").Sort.SortFields.Clear
    Sheets("IT").Sort.SortFields.Add Key:=Range("R1:R" & LastRow), _
    SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    Sheets("IT").Sort.SortFields.Add Key:=Range("S1:S" & LastRow), _
    SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With Sheets("IT").Sort
    .SetRange Range("A1:AR" & LastRow)
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=2, Criteria1:="Y"
    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=3, Criteria1:="1"
    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=6, Criteria1:=">=" & CLng(Date)
    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=10, Criteria1:=Array( _
    "Trentino-Alto Adige", "Tuscany", "Emilia-Romagna", "Veneto", "Latium", "Lombardy"), Operator:=xlFilterValues
    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=8, Criteria1:="Hotel"
    Sheets("IT").Range("A2:AR" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("IT GROUPS").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    If Sheets("IT").AutoFilterMode = True Then Sheets("IT").AutoFilterMode = False
    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=6, Criteria1:=">=" & CLng(Date)
    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=10, Criteria1:=Array( _
    "Sicily", "Aosta Valley", "Campania", "Liguria", "Basilicata", "Marches"), Operator:=xlFilterValues
    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=8, Criteria1:="Hotel"
    Sheets("IT").Range("A2:AR" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("IT GROUPS").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    If Sheets("IT").AutoFilterMode = True Then Sheets("IT").AutoFilterMode = False
    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=6, Criteria1:=">=" & CLng(Date)
    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=10, Criteria1:=Array( _
    "Piedmont", "Apulia", "Umbria", "Abruzzo", "Sardinia", "Calabria"), Operator:=xlFilterValues
    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=8, Criteria1:="Hotel"
    Sheets("IT").Range("A2:AR" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("IT GROUPS").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    If Sheets("IT").AutoFilterMode = True Then Sheets("IT").AutoFilterMode = False
    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=6, Criteria1:=">=" & CLng(Date)
    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=8, Criteria1:="Package"
    Sheets("IT").Range("A2:AR" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("IT GROUPS").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    If Sheets("IT").AutoFilterMode = True Then Sheets("IT").AutoFilterMode = False
    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=2, Criteria1:="Y"
    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=3, Criteria1:="1"
    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=6, Criteria1:=">=" & CLng(Date)
    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=7, Criteria1:=Array( _
    "LONG_HAUL", "MIDDLE_HAUL"), Operator:=xlFilterValues
    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=8, Criteria1:="Hotel"
    Sheets("IT").Range("A2:AR" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("IT GROUPS").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    If Sheets("IT").AutoFilterMode = True Then Sheets("IT").AutoFilterMode = False
    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=6, Criteria1:=">=" & CLng(Date)

    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=8, Criteria1:="HOTEL"
    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=7, Criteria1:="EUROPE"
    Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=9, Criteria1:="<>Italy"
    Sheets("IT").Range("A2:AR" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("IT GROUPS").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    If Sheets("IT").AutoFilterMode = True Then Sheets("IT").AutoFilterMode = False
    Application.ScreenUpdating = True
    End Sub
    On top of each group that we "pasted" on the new sheet, I need to add 2 rows, the first one should be empty and then the second one of each group as following:

    "DOM1" for the first group, "DOM2" for the second group, "DOM3" for the third group, "PKG" for the fourth group, "INT" for the fifth group and "EU" for the sixth.
    Kindly check the following file. Sheet named "IT GROUPS FINAL" is what I am looking for.

    Then, I would like to have another Macro (not sure if this is possible to be honest). Please see the tab named "RANKING".
    I would like to create a new sheet named "RANKING".
    - Row 2 header
    - A3:B38 is always looping till row 1010
    - I would like Macro to extract the row of "IT GROUPS FINAL" of each category that is matching with the category in column B in ranking.
    To be clearer: the 1st DOM1 in Column B of sheet "RANKING" needs to be the 1st row of group DOM1 in sheet "IT GROUP FINAL", the 1st PKG in Column B of sheet "RANKING" needs to be the 1st row of group PKG in sheet "IT GROUP FINAL", etc., etc.

    This as I would like the final result

    https://www.dropbox.com/s/zoh2knza46...N%29.xlsx?dl=0

    Not sure if it is possible. Anyone able to help me please?

    P.S
    I have just edited the message to be, I hope, more precise.
    The code for adding the rows needs to be added between the rows I have underscored on my above quote.

    Thank you in advance
    Last edited by Giancar; 01-03-2018 at 07:33 PM.

  2. #2
    Valued Forum Contributor
    Join Date
    10-06-2017
    Location
    drevni ruchadlo
    MS-Off Ver
    old
    Posts
    664

    Re: Order list with a Macro

    Very beautiful macro-quotation ... ... what is it about ?

  3. #3
    Registered User
    Join Date
    01-03-2018
    Location
    England
    MS-Off Ver
    MSO 2016
    Posts
    5

    Re: Order list with a Macro

    So....long story.

    You need to open the dropbox file to understand

    This Macro is working on the sheet named "IT". It copies rows in another sheet called "IT GROUPS", based on many criteria.

    What I am trying to do is an automatic order:
    a) Sort by Column R (Largest to Smallest), if value is the same sort by column S (Largest to smallest)
    b) Column F needs to be today or bigger
    c) I need to divide all the rows in sub categories:
    - 1st group: Column J is "Tuscany" OR "Trentino-Alto Adige" OR "Emilia-Romagna" OR "Veneto" OR "Latium" OR "Lombardy" AND Column H is "Hotel" (then I need to copy the Column A of the results given in a different sheet)
    - 2nd group: Column J is "Sicily" OR "Aosta Valley" OR "Campania" OR "Liguria" OR "Basilicata" OR "Marches" (just an example) AND Column H is "Hotel" (then I need to copy the Column A of the results given in a different sheet) - 3rd group: Column J is "Piedmont" OR "Apulia" OR "Umbria" OR "Abruzzo" OR "Sardinia" OR "Calabria" (just an example) AND Column H is "Hotel" (then I need to copy the Column A of the results given in a different sheet)
    - 4th group: Column H is "Package" (then I need to copy the Column A of the results given in a different sheet)
    -5th group: Column G is "LONG_HAUL" or "MIDDLE_HAUL" AND Column H is "Hotel" (then I need to copy the Column A of the results given in a different sheet)
    - 6th group: Column G is "EUROPE", AND Column I is not "Italy". (then I need to copy the Column A of the results given in a different sheet)

    These groups are only for sheet "IT" cause then for "FR" and "ES" I have different groups, but then if it works for IT, I will replace with different groups of course.

    The code I have gives me a entire list (IT GROUPS) but I need some extra rows between them, because then I need to copy and paste to another sheet and I think it will be helpful.

    Not sure I am that clear. Do you know a code that I can add to that code to give me empty rows between the categories?

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1