Excel User Group
Microsoft Excel blogs, forums, files. Read, ask questions, provide answers.

Re-order a group of cells based on a list

Latest post Tue, May 20 2008 4:12 AM by Bob Phillips. 11 replies.
  • Fri, May 9 2008 1:07 PM

    • torre751
    • Top 500 Contributor
    • Joined on Fri, May 9 2008
    • Posts 4
    • Points 100

    Re-order a group of cells based on a list

    I have text in a single cell that's separated by a "/" that i'd like to reorder within the cell based on a list in a separate .xls file e.g.

    In one cell i have "Benton/Ames/Depew/Quitman" 

    I have a list in a separate xls file that reads vertically:

    Depew

    Ames

    Chickasaw

    Sheridan

    Quitman

    Federal

    Benton

    I'd like to reorder the contents of the cell based on the list.  So it would read "Depew/Ames/Quitman/Benton". There are not more than 5 things to reorder in a cell and the list to sort from is maybe 20 long. Everything is text, and occasionally the things repeat (e.g. "Ames/Ames/Quitman"). If they repeat, I'd like to delete the extra (So "Ames/Quitman" from the previous example). I've figured out a way to delete the extra, but I can't think of how to sort them correctly.

    Any help would be greatly appreciated.

     

    Filed under:
    • Post Points: 21
  • Fri, May 9 2008 5:56 PM In reply to

    • Nick Hodge
    • Top 10 Contributor
    • Joined on Sun, Dec 23 2007
    • Southampton
    • Posts 543
    • Points 9,431
    • MVP

    Re: Re-order a group of cells based on a list

    torre751

    You are stretching it there. The only way you will be able to do this is with a decent amount of VBA code. First to parse the data in a single cell and then to apply a cutom sort. IMHO, not a trivial matter

    Regards
    Nick Hodge
    Microsoft MVP, Excel
    Southampton, UK

    • Post Points: 21
  • Fri, May 9 2008 7:10 PM In reply to

    Re: Re-order a group of cells based on a list

    I thought that on first reading Nick, but on reflection, it may not be that hard.

    Get the cell items using Split, drop it into a range, create a custom list from the original data, sort it using Excel's sort, Join the range, and replace.


    Might have a go tomorrow.

    Regards

    Bob

    • Post Points: 5
  • Fri, May 9 2008 7:51 PM In reply to

    Re: Re-order a group of cells based on a list

    Okay, money where your mouth is time!

     

    Public Function SortCellSpecial()
    Dim LastRow
    Dim CustomListNum As Long
    Dim aryItems
    Dim rng As Range

        With Workbooks("CustomSortList.xls").Worksheets(1)
       
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            Application.AddCustomList ListArray:=.Range("A1").Resize(LastRow)
            CustomListNum = GetListNum(.Range("A1").Resize(LastRow))
        End With

        With ActiveSheet
           
            aryItems = Split(.Range("A1"), "/")
            Set rng = .Range("H1").Resize(UBound(aryItems) - LBound(aryItems) + 1)
            rng = Application.Transpose(aryItems)
           
            rng.Sort Key1:=.Range("H1"), _
                     Order1:=xlAscending, _
                     Header:=xlNo, _
                     OrderCustom:=CustomListNum + 1, _
                     MatchCase:=False, _
                     Orientation:=xlTopToBottom
                          
            aryItems = Application.Transpose(rng)
            .Range("A1").Value = Join(aryItems, "/")
            rng.ClearContents
        End With
       
        Application.DeleteCustomList listnum:=CustomListNum

    End Function

     

    Private Function GetListNum(ByRef rng As Range) As Variant
    Dim i As Long, j As Long
    Dim ary
    Dim OK As Boolean
    Dim cell As Range
        
        For i = 1 To Application.CustomListCount
            ary = Application.GetCustomListContents(i)
            j = LBound(ary)

            OK = True
            For Each cell In rng
               
                If cell.Value <> ary(j) Then
               
                    OK = False
                    Exit For
                End If
                j = j + 1
            Next cell
           
            If OK Then
               
                GetListNum = i
                Exit For
            End If
        Next i
    End Function

     

    Regards

    Bob

    • Post Points: 21
  • Sat, May 10 2008 3:51 AM In reply to

    • Nick Hodge
    • Top 10 Contributor
    • Joined on Sun, Dec 23 2007
    • Southampton
    • Posts 543
    • Points 9,431
    • MVP

    Re: Re-order a group of cells based on a list

    Bob

    Split and Join...why didn't I think of that? It looked far more complicated than that, so now to jump on your glory, why the extra private function? I amended it like so...

     

    Public Function SortCellSpecial()
    Dim LastRow
    Dim CustomListNum As Long
    Dim aryItems
    Dim rng As Range
    
        With Workbooks("CustomSortList.xls").Worksheets(1)
        
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            Application.AddCustomList ListArray:=.Range("A1").Resize(LastRow)
            CustomListNum = Application.GetCustomListNum(.Range("A1").Resize(LastRow).Value)
        End With
    
        With ActiveSheet
            
            aryItems = Split(.Range("A1"), "/")
            Set rng = .Range("H1").Resize(UBound(aryItems) - LBound(aryItems) + 1)
            rng = Application.Transpose(aryItems)
            
            rng.Sort Key1:=.Range("H1"), _
                     Order1:=xlAscending, _
                     Header:=xlNo, _
                     OrderCustom:=CustomListNum + 1, _
                     MatchCase:=False, _
                     Orientation:=xlTopToBottom
                           
            aryItems = Application.Transpose(rng)
            .Range("A1").Value = Join(aryItems, "/")
            rng.ClearContents
        End With
        
        Application.DeleteCustomList listnum:=CustomListNum
    
    End Function

    Regards
    Nick Hodge
    Microsoft MVP, Excel
    Southampton, UK

    Filed under: ,
    • Post Points: 21
  • Sat, May 10 2008 4:19 AM In reply to

    Re: Re-order a group of cells based on a list

    Didn't spot GetCustomListNum when I wrote it.

     

    BTW, what tags do you use for that better formatted code?

     

    Regards

    Bob

    • Post Points: 21
  • Sat, May 10 2008 5:04 AM In reply to

    • Nick Hodge
    • Top 10 Contributor
    • Joined on Sun, Dec 23 2007
    • Southampton
    • Posts 543
    • Points 9,431
    • MVP

    Re: Re-order a group of cells based on a list

    Bob

    I'm also not sure 'we' couldn't have just taken the count and run with that as the added one is added to the end of the list of custom sorts anyhow.

    On the code front. It does make a pretty good job, but is more convaluted than the [code] tags you are using. I use Windows Live Writer (WLW) for all my blog posting and that allows add-ons, one of which is a code snippet one. I just paste my code in the window and select either VB for VBA or HTML for RibbonX and it makes a pretty good stab. The best bit is you can copy and paste it into VBE without all the garbage that seems to appear with [code].

    Regards
    Nick Hodge
    Microsoft MVP, Excel
    Southampton, UK

    • Post Points: 37
  • Sat, May 10 2008 5:32 AM In reply to

    Re: Re-order a group of cells based on a list

    I originally thought that back a couple of years ago when I came up with this VBA sorting technique, but guess what, I found that it wasn't always true. And why is the list number offset by 1 in the Sort argument? Typical consistent MS.


    I think I will pass on the tags. Although Karl Peterson gave me something once that formats code, I will try and dig that out and see how it works.

    Regards

    Bob

    • Post Points: 5
  • Thu, May 15 2008 5:30 PM In reply to

    • torre751
    • Top 500 Contributor
    • Joined on Fri, May 9 2008
    • Posts 4
    • Points 100

    Re: Re-order a group of cells based on a list

     Thank you Nick and Bob, that works tremendously well.  I really do appreciate the assistance.

    When i'm running through the code, testing and making modifications, I'll hit a runtime error 1004 when i get to the bold/italicized line below.  I did a little research and found that it was because a custom list that was identical already exists.  I tried moving the Application.DeleteCustomList listnum:=CustomListNum further ahead to delete the custom list before recreating it (if what I said makes any sense) and no dice.  I also tried assigning the range to a variable as is commented out in the italicized portion of code below and still no dice.  This error seems to come and go while I'm fiddling with things, I'm sure there's a reason, it's just beyond my understanding.

    Hats off to you both though, I am very grateful and thanks again.

     

    Option Explicit
    Private Function AbbreviationSorter()
    Dim LastRow As Double
    Dim CustomListNum As Long
    Dim aryItems As Variant
    Dim rng As Range
    Dim k As Long
    Dim rngCounter As Integer

            Application.DeleteCustomList listnum:=CustomListNum
           
        With Workbooks("Strat Column Abbreviations.xls").Worksheets(1)
        

            'LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            'TempArray = Range("A1").Resize(LastRow)
            'Application.AddCustomList ListArray:=TempArray
            'CustomListNum = GetListNum(.Range("A1").Resize(LastRow))

            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            Application.AddCustomList ListArray:=.Range("A1").Resize(LastRow)
            CustomListNum = Application.GetCustomListNum(.Range("A1").Resize(LastRow).Value)


        End With
       
    For k = 14 To 1 Step -1
        If Cells(k, 2) <> "" Then
       
        With ActiveSheet
            aryItems = Split(.Cells(k, 8), "/")
            Set rng = .Cells(k, 13).Resize(UBound(aryItems) - LBound(aryItems) + 1)
            rngCounter = rng.Count
           
            If rngCounter > 1 Then
                rng = Application.Transpose(aryItems)
                rng.Sort Key1:=.Cells(k, 13), _
                         Order1:=xlAscending, _
                         Header:=xlNo, _
                         OrderCustom:=CustomListNum + 1, _
                         MatchCase:=False, _
                         Orientation:=xlTopToBottom
                              
                aryItems = Application.Transpose(rng)
                .Cells(k, 8).Value = Join(aryItems, "/")
            End If
            rng.ClearContents
        End With
       
        End If
    Next k

        Application.DeleteCustomList listnum:=CustomListNum

    End Function

    • Post Points: 21
  • Thu, May 15 2008 6:15 PM In reply to

    Re: Re-order a group of cells based on a list

    I thought we had lost you.

     

    As to the code, test whether the list exists before adding it

    <pre>

    Private Function AbbreviationSorter()
    Dim LastRow As Double
    Dim CustomListNum As Long
    Dim aryItems As Variant
    Dim rng As Range
    Dim k As Long
    Dim rngCounter As Integer

        With Workbooks("Strat Column Abbreviations.xls").Worksheets(1)
       
            'LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            'TempArray = Range("A1").Resize(LastRow)
            'Application.AddCustomList ListArray:=TempArray
            'CustomListNum = GetListNum(.Range("A1").Resize(LastRow))
       
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            CustomListNum = Application.GetCustomListNum(.Range("A1").Resize(LastRow).Value)
            If CustomListNum = 0 Then
           
                Application.AddCustomList ListArray:=.Range("A1").Resize(LastRow)
                CustomListNum = Application.GetCustomListNum(.Range("A1").Resize(LastRow).Value)
            End If

        End With
    </pre>

     

    BTW, just after this code, you use Activesheet. Is that correct?

     

    Regards

    Bob

    • Post Points: 21
  • Mon, May 19 2008 8:52 AM In reply to

    • torre751
    • Top 500 Contributor
    • Joined on Fri, May 9 2008
    • Posts 4
    • Points 100

    Re: Re-order a group of cells based on a list

     Bob-

    I'm lost perhaps, but just drowning with other projects so this particular project was reduced to a simmer.

    That if statement works quite well. I'm not familiar enough with custom lists to have a good sense of their functionality so I may ask very simple questions...

    I do use activesheet after.  I use the macro with whatever particular spreadsheet i happen to be working with, but i'm not sure if that's the 'correct' way to go about it.

    Cheers-

    • Post Points: 21
  • Tue, May 20 2008 4:12 AM In reply to

    Re: Re-order a group of cells based on a list

    It is just that we start with the first worksheet in the nominated workbook, then we switch to Activesheet. They may not be the same sheet (they may not even be the same workbook).

    Regards

    Bob

    • Post Points: 5
Page 1 of 1 (12 items) | RSS
Copyright Excel User Group and the relevant contributors, 2010. All Trade Marks acknowledged. This site is a peer-to-peer site and NOT affiliated in any way to Microsoft Corp. All rights reserved.