Sort/Arrange Rows based on Cell Value in Range VBA

crp

New Member
Joined
Jul 30, 2021
Messages
18
Office Version
  1. 365
Platform
  1. Windows
I have a series of data compiled into one excel sheet. The order of the data depends on each row's association to other rows, based on their LinkTo values. Below is an example of before, and how I need the data to be organized. I'd like for this to be automated in VBA.

Example Raw Data
IDCategoryLinkTo
1Fruit
2Onion4
3Apple1
4Vegetable
5Banana1
6Red Apple3

Example Desired Result
IDCategoryLinkTo
1Fruit
3Apple1
6Red Apple3
5Banana1
4Vegetable
2Onion4
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Starting with this data set
crp 20210730.xlsm
ABCDEFGHIJKLMN
1IDCategoryLinkTo
21234-2Fruit1234-0
31234-1Apple1234-2
41234-3Tomato1234-2 1234-4
51234-4Vegetable1234-15
61234-5Banana1234-2
71234-6Green Apple1234-1
81234-7Onion1234-4
91234-8Orange1234-2
101234-9Red Onion1234-7
Sheet1


Using this code
VBA Code:
Sub LinkSort()
    Dim lRow As Long, match As Long, noIDs As Long, iD As Long, idPos As Long, cRow As Long, endLoop As Long
    Dim multIDs As Long
    Dim str As String, replaced As String, LnkID As String
    Dim rng As Range
   
    Application.ScreenUpdating = False
     'Get last row of data in column "A"
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
   
    'Set r to the data in column "A" so we can search for LinkTo ID's
    Set rng = Range(Cells(1, 1), Cells(lRow, 1))
   
    'Set loop variables
    endLoop = rng.Rows.Count
    cRow = 2
    multIDs = 0
   
    'Loop through the data and find a match for the LinkTo ID
    While cRow <= endLoop
        str = Cells(cRow, "N").Value
        replaced = Replace(str, "-", "")
        noIDs = Len(str) - Len(replaced)
              
        Select Case noIDs
       
            Case Is = 1 'Move the item below the matching LinkTo ID
                On Error Resume Next 'in case no match found match = 0
                match = Application.match(Cells(cRow, "N").Value, rng, 0) + 1
                If match <> 0 And cRow <> match Then
                    On Error GoTo 0
                    Rows(cRow & ":" & cRow).Cut
                    Rows(match & ":" & match).Insert Shift:=xlDown
                    If match > rng.Rows.Count Then ' if match + 1 is greater than the number of rows we need to extend the range by 1 row
                        Set rng = Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
                    End If
                    match = 0
                Else
                    cRow = cRow + 1
                    match = 0
                End If
               
            Case Is > 1 'Move the item to the bottom of the list and increment multIDs and reduce endLoop by 1
                multIDs = multIDs + 1
                Rows(cRow & ":" & cRow).Cut
                Rows(Cells(Rows.Count, 1).End(xlUp).Row + 1 & ":" & Cells(Rows.Count, 1).End(xlUp).Row + 1).Insert Shift:=xlDown
                Set rng = Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
                endLoop = endLoop - 1
                match = 0
           
            Case Is = 0 'No Id indicates bad data so we will skip this item
                cRow = cRow + 1
                match = 0
        End Select
        On Error GoTo 0
   Wend
  
   'Here is where we will deal with all the items with multiple LinkTo ids
   If multIDs <> 0 Then
        cRow = endLoop + 1
        endLoop = endLoop + multIDs
        For cRow = cRow To endLoop
            str = Cells(cRow, "N").Value
            replaced = Replace(str, "-", "")
            noIDs = Len(str) - Len(replaced)
            Rows(cRow & ":" & cRow).Copy
            Rows(cRow + 1 & ":" & cRow + noIDs - 1).Insert Shift:=xlDown
            Application.CutCopyMode = False
            Set rng = Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
            endLoop = endLoop + noIDs - 1
            LnkID = Cells(cRow, "N").Value
           
            idPos = 0
           
            For iD = 1 To noIDs
                idPos = InStr(idPos + 1, LnkID, "-", vbTextCompare)
                If idPos <> 0 Then
                    On Error Resume Next
                    match = Application.match(Mid(LnkID, idPos - 4, 6), rng, 0)
                    If match <> 0 And cRow <> match + 1 Then
                        On Error GoTo 0
                        Rows(cRow & ":" & cRow).Cut
                        Rows(match + 1 & ":" & match + 1).Insert Shift:=xlDown
                        If cRow > match + 1 Then cRow = cRow + 1
                    End If
                End If
            Next iD
        Next cRow
    End If
    Application.ScreenUpdating = True
End Sub

I get this result
crp 20210730.xlsm
ABCDEFGHIJKLMN
1IDCategoryLinkTo
21234-2Fruit1234-0
31234-3Tomato1234-2 1234-4
41234-8Orange1234-2
51234-5Banana1234-2
61234-1Apple1234-2
71234-6Green Apple1234-1
81234-4Vegetable1234-15
91234-3Tomato1234-2 1234-4
101234-7Onion1234-4
111234-9Red Onion1234-7
Sheet1


Please let me know if there is something different about the data set from yours.
 
Upvote 0
I think the issue deals with having multiple LinkTos as the first line of data. I reattempted with Tomato as the top row (having 2 LinkTos) and also tried adding another LinkTo in the original dataset to Fruit and the same thing happened.
 
Upvote 0
I adjusted for that so that if an item has multiple linkto ids, it is moved to the bottom and only acted on AFTER all other rows have been resorted. Please take the last code I posted and replace whatever you have with it and test.
 
Upvote 0
Right. I tried your last code from 2:19 today. If you use the same starting data set, but also add 1234-15 to N2, I end up with this:

3 Aug Test.PNG
 
Upvote 0
That's really weird. Please check the data in column N for "Orange". There should be no reason that is copied at all much less so many times. working without your actual data is really crippling being able to troubleshoot this problem.
 
Upvote 0
Ok, I noticed something that might be an issue.

1. Fruit has two LinkTo ids which will not be found in the data correct?
2. some LinkTo ids are longer than ####-# meaning they have four digits before the "-" and more than one digit after it. What is the expected format of this data item? Can it be ####-####? or is ####-## the max?
3. What differentiates "Fruit" with two LinkTo ids from "Tomato" with two LinkTo Ids? If you notice, in the results post running the macro Fruit is duplicated and it shouldn't be correct? If that is right, then I need a way to determine if the item with multiple LinkTo ids is Fruit (or any other category that will NOT have a corresponding LinkTo id in the data) so that it is NOT replicated like "Tomato" is.
 
Upvote 0
I was able to replicate your results when I entered the LinkTo id for Fruit as
crp 20210730.xlsm
ABCDEFGHIJKLMN
1IDCategoryLinkTo
21234-2Fruit1234-0 1234-15
Sheet2

The issue is that Fruit is treated just like Tomato and the code duplicates Fruit and it shouldn't. The answer to Question #3 above is really going to be the thing that allows us to break through here. Also need an answer to the rest, especially #2 as well because I need a consistent way to be able to extract each LinkTo id from the cell value when there are multiple LinkTo ids.
crp 20210730.xlsm
ABCDEFGHIJKLMN
1IDCategoryLinkTo
21234-4Vegetable1234-15
31234-7Onion1234-4
41234-9Red Onion1234-7
51234-2Fruit1234-0 1234-15
61234-8Orange1234-2
71234-8Orange1234-2
81234-8Orange1234-2
91234-8Orange1234-2
101234-8Orange1234-2
111234-8Orange1234-2
121234-8Orange1234-2
131234-5Banana1234-2
141234-1Apple1234-2
151234-2Fruit1234-0 1234-15
161234-6Green Apple1234-1
171234-3Tomato1234-2 1234-4
Sheet1
 
Upvote 0
Ok, I noticed something that might be an issue.

1. Fruit has two LinkTo ids which will not be found in the data correct?
2. some LinkTo ids are longer than ####-# meaning they have four digits before the "-" and more than one digit after it. What is the expected format of this data item? Can it be ####-####? or is ####-## the max?
3. What differentiates "Fruit" with two LinkTo ids from "Tomato" with two LinkTo Ids? If you notice, in the results post running the macro Fruit is duplicated and it shouldn't be correct? If that is right, then I need a way to determine if the item with multiple LinkTo ids is Fruit (or any other category that will NOT have a corresponding LinkTo id in the data) so that it is NOT replicated like "Tomato" is.
1. Correct. It is possible to have more than 2 LinkTos that will not be found as well.
2. All of the IDs in column A share the first 5 digits ("12345"). It is possible for there to be up to 3 additional digits following before the "-", after which it could be up to 4 digits. I noticed in your code how you were distinguishing and counting digits following the "-".

For this section:
 
Upvote 0
1. Correct. It is possible to have more than 2 LinkTos that will not be found as well. Or to have some be found and others not.
2. All of the IDs in column A share the first 5 digits ("12345"). It is possible for there to be up to 3 additional digits following before the "-", after which it could be up to 6 digits ("12345XXX-XXXXXX"). I noticed in your code how you were distinguishing and counting digits following the "-".

For this section:
For iD = 1 To noIDs
idPos = InStr(idPos + 1, LnkID, "-", vbTextCompare)
If idPos <> 0 Then
On Error Resume Next
match = Application.match(Mid(LnkID, idPos - 4, 6), rng, 0)

and other locations that are searching for "-", could it be adjusted to "12345" (as in the first 5 digits of the ID)? Then the search start location and character length would also be adjusted to:

For iD = 1 To noIDs
idPos = InStr(idPos + 1, LnkID, "12345", vbTextCompare)
If idPos <> 0 Then
On Error Resume Next
match = Application.match(Mid(LnkID, idPos - 5, 15), rng, 0)

3. The only differentiation between "Fruit" and "Tomato" is the category level. "Tomato" or similar descriptor can link up to "Fruit", but "Fruit" cannot link up to "Tomato". It is possible for any level (Fruit, Apple, Green Apple) to have multiple LinkTos and for some to not be found, but again, they can only link up and should show traceability from the lowest to the highest level (Green Apple is an Apple, which is a Fruit.) You are correct that Fruit should not be duplicated. Unfortunately there are no other descriptors in the data that distinguish Fruit from Tomato/Apple/etc. If it would be easier, we could add another column at the end and identify this? Column W: Fruit/Vegetable = X, Tomato/Apple/etc = Y, Green Apple/etc = Z ?
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,912
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top