Consulting

Page 1 of 3 1 2 3 LastLast
Results 1 to 20 of 55

Thread: Sorting sections within large table

  1. #1
    VBAX Regular
    Joined
    May 2022
    Posts
    31
    Location

    Sorting sections within large table

    Hi dear Lucas
    I'll be appreciate if you help me too with my problem almost the same.
    I have a large table with more than 5000 rows with more than 700 section, each section have their own data in about 7 to 11 rows and what i need is to have a code to sort each section with my selection rows and sorting them by column Q. this column is permanently fixed for my sorting.
    i mean there is no need to ask user which column i need to sort by.
    i will be thankful if you would help me for my challenge.
    here is a part of my table:
    partial_table1.jpg
    For example i want to select rows in each part of my table hat has No.1 of 2 or... in column A but from G column to Ah and then sort them based on column Q with minimum number on top.
    Attached Images Attached Images
    Last edited by Javid; 05-19-2022 at 10:06 AM. Reason: Picture Attached and more explanation

  2. #2
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,783
    Location
    WOW! Lookee all those Merged Cells; and Images, Hidden Columns, Colored Rows, Highlighted Cells, Borders and Conditional Formats.

    I pass. Good luck.

    The only Formatting there should be is: The Entire Header Row Height Resized, Bold, Font Size +1, Wrap Text, and Bottom Border. Maybe a Border above each section. A Header that covers many Columns (V:W; Y:Z) can be Formatted "Center Across Selection". Vertical Center is OK (A,B,C; V:W)

    What you have is a single Database Table with 700 Sections, each of which must be found and programmatically described. Very complex operation with Merged Cells. Looks something like
     
    Set FirstCell = TitleCell.MergesArea.Cells(1)
    LastRow = TitleCell.MergedArea.Cells(TitleCell.MergedArea.Cells.Count).Row
    LastColumn = Cells(Columns.Count, "A").End(xlToRight).Column
    Set LastCell = Range(LastRow, LastColumn)
    Set Section = Range(FirstCell, LastCell)
    If you follow my Formatting guidelines above, AND Insert an Empty Row above each Section's Top Border, AND add a vertical Border on the Right that covers only that Table's Rows, you will have 700 DB Tables, any one of which can be described by
    Table = TitleCell.CurrentRegion
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  3. #3
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,617
    try running this which acts on the active sheet:
    Sub blah()
    Set mydict = CreateObject("Scripting.Dictionary")
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    For Each cll In Range("B12:B" & lr).Cells
      If Not mydict.exists(cll.MergeArea.Address) Then mydict.Add cll.MergeArea.Address, cll.MergeArea
    Next cll
    For Each itm In mydict.items
      itm.EntireRow.Columns("G:AH").Sort key1:=Range("Q1"), order1:=1
    Next itm
    End Sub
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  4. #4
    VBAX Regular
    Joined
    May 2022
    Posts
    31
    Location
    Hi dear friend,
    So many thanks for your answer and code.
    I tried to test it but it gives me no act on my data file
    Thanks again and good luck.

  5. #5
    VBAX Regular
    Joined
    May 2022
    Posts
    31
    Location
    Hi dear SamT,
    I appreciate of your attention and response.
    And also many thanks for your helpful tips, I'll try to edit and change my table and then will test your code on it.
    Hope it solves my problem.
    Let me say I learned great lessons from your tips.
    Thanks again and Good luck

  6. #6
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,187
    Location
    Javid, are you able to upload a sample file so we can test our suggestions?
    Remember To Do the Following....
    Use tags when posting code to the thread,
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  7. #7
    VBAX Regular
    Joined
    May 2022
    Posts
    31
    Location

    Uploading excel sample file

    Dear Aussiebear I did upload an image sample on my request, do you mean a sample of excel file you need?
    Otherwise Would you please tell me how can i upload my Excel sample file?
    I can't see any tools in toolbar for attaching excel file!
    Sample File.xlsx
    Hope i did it right

    Last edited by Javid; 05-19-2022 at 11:04 PM. Reason: more explanation and more sample file

  8. #8
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,187
    Location
    "Images", are for polar bears in space suits. Just a dummy file with some sample data (must be similar) will be fine.
    Remember To Do the Following....
    Use tags when posting code to the thread,
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  9. #9
    VBAX Regular
    Joined
    May 2022
    Posts
    31
    Location
    Thanks and let me know that can you see my attachment now?

  10. #10
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,187
    Location
    Yes I can. Just for future reference you can attach files by clicking on Go Advanced/ Manage Attachments/ Choose File/ Upload
    Remember To Do the Following....
    Use tags when posting code to the thread,
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  11. #11
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,187
    Location
    First issue I can see is apart from the merged cells is that if we use "Column Q to sort Minimum to Maximum" there are blank cells. What happens to that data?
    Remember To Do the Following....
    Use tags when posting code to the thread,
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  12. #12
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,393
    Location
    1. How do you want Col Q sorted?

    For example, section 1 has 1 entry filled outy of 7 rows, and section 2 has 2 cells filled in out of 7 rows


    2. Sort each section keeping the rows together? Which entry do I sort by (e.g. section 2 has 2)?

    3. Delete rows with no entry in column Q, or just sort them to the bottom?

    Capture.JPG
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  13. #13
    VBAX Expert
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    814
    Location
    If you amend your formula in column Q From:
    =IF(OR(P12=0,M12=0),"",P12/M12)
    To:
    =IF(OR(P12=0,M12=0),0,P12/M12)
    And are hell bent on keeping the merged cells then:
    Sub test()    
        Dim wsCP As Worksheet, rng As Range, rCell As Range, tmpRng As Range
        
        Set wsCP = Sheets("Comparateur prix")
        Set rng = wsCP.Range("A12:A" & wsCP.Range("A" & Rows.Count).End(xlUp).Row)
    
    
        Set tmpRng = rng(1, 1)
        For Each rCell In rng.Cells
            With rCell
                If .MergeCells Then
                    If Intersect(rCell, tmpRng) Is Nothing Then
                        .MergeArea.Offset(, 6).Resize(.MergeArea.Rows.Count, 27).Sort wsCP.Range("Q9"), xlDescending
                        Set tmpRng = .MergeArea
                    End If
                End If
            End With
        Next
    End Sub
    Hope this helps
    If things don't change they stay the same
    Quite often there is a picnic problem (problem in chair not in computer)
    "We were not told it was impossible, so we did it."

  14. #14
    VBAX Regular
    Joined
    May 2022
    Posts
    31
    Location
    Thanks my friend

  15. #15
    VBAX Regular
    Joined
    May 2022
    Posts
    31
    Location
    Quote Originally Posted by Aussiebear View Post
    First issue I can see is apart from the merged cells is that if we use "Column Q to sort Minimum to Maximum" there are blank cells. What happens to that data?
    The section with no entry will change with it's own data soon, so we don't need to change or move them in data sheet

  16. #16
    VBAX Regular
    Joined
    May 2022
    Posts
    31
    Location
    So many thanks dear Georgiboy,
    Let me test your code and will notify the result.
    Last edited by Aussiebear; 05-22-2022 at 03:20 AM. Reason: Remove unwarranted Quote

  17. #17
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,617
    Quote Originally Posted by Javid View Post
    Hi dear friend,
    So many thanks for your answer and code.
    I tried to test it but it gives me no act on my data file
    Thanks again and good luck.
    That's why pictures are useless; column B looks like merged cells in the picture, but they're not.
    Column A does have merged cells so changing my offering to look at that instead of column B gives:
    Sub blah()
    Set mydict = CreateObject("Scripting.Dictionary")
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    For Each cll In Range("A12:A" & lr).Cells
      If Not mydict.exists(cll.MergeArea.Address) Then mydict.Add cll.MergeArea.Address, cll.MergeArea
    Next cll
    For Each itm In mydict.items
      itm.EntireRow.Columns("G:AH").Sort key1:=Range("Q1"), order1:=1
    Next itm
    End Sub
    and works over here.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  18. #18
    VBAX Regular
    Joined
    May 2022
    Posts
    31
    Location
    Oh Dear my friend it's working very nice
    Thank you so much for your help
    Last edited by Aussiebear; 05-22-2022 at 03:21 AM. Reason: remove unwarranted quote

  19. #19
    VBAX Regular
    Joined
    May 2022
    Posts
    31
    Location

    Conditional Format

    Now i need another help:
    How may i change the background of two cells "I" and "Q" in each row with conditional format based on cell "Q" just where cell Q containing the minimum price, in whole data sheet?
    These two cells is important because of the minimum price in cell Q and the vendor's name.
    In fact I need yellow background for both of these cells, even if we don't sort each or some sections yet, but just where lower price and it's vendor name are both in the same row.
    And It's clear that whenever sorting is done, the yellow background will shift with the sorting.
    Last edited by Javid; 05-20-2022 at 04:16 AM. Reason: more explanation

  20. #20
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,617
    try:
    Sub blah()
    Set mydict = CreateObject("Scripting.Dictionary")
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    For Each cll In Range("A12:A" & lr).Cells
      If Not mydict.exists(cll.MergeArea.Address) Then mydict.Add cll.MergeArea.Address, cll.MergeArea
    Next cll
    Range("Q:Q,I:I").FormatConditions.Delete
    For Each itm In mydict.items
      itm.EntireRow.Columns("G:AH").Sort key1:=Range("Q1"), order1:=1
      Set rngCF = Intersect(itm.EntireRow, Range("I:I,Q:Q"))
      With rngCF.FormatConditions.Add(Type:=xlExpression, Formula1:="=" & rngCF.Areas(2).Cells(1).Address(0, 1) & "=MIN(" & rngCF.Areas(2).Address & ")")
        .StopIfTrue = False
        With .Interior
          .PatternColorIndex = xlAutomatic
          .Color = 65535
          .TintAndShade = 0
        End With
      End With
    Next itm
    End Sub
    Don't forget to remove any manual colours you've put in.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

Posting Permissions

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