Auto renumber a queue

W

wreckerp

New Member
Joined
Oct 30, 2019
Messages
6
Hi all,

I have a list of items with a priority order with 1 being the highest priority. Sometimes, the priority will change and 1 will become 3.

Is there a way to auto renumber the cells so that when a priority changes (for example: #1 becomes #3 ), the list will automatically shift and readjust the priorities so that when I manually change #1 to #3 , #2 becomes 1 and #3 becomes 2 ?

I've seen an older thread with a similar problem but there wasn't any solutions.

Thanks in advance for the help.

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Order/priority[/TD]
[TD]Items[/TD]
[TD]Price[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]A[/TD]
[TD]100[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]B[/TD]
[TD]50[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]C[/TD]
[TD]35[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]D[/TD]
[TD]30[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]E[/TD]
[TD]65[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]F[/TD]
[TD]10[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes
Welcome to the forum
It is possible to do what you want with VBA

Are there only 3 columns of data ?
Is each order/priority unique ?
(in other words - is every value in column A different to every other value in column A ?)
Is the data always sorted by priority ?
 
Upvote 0
This assumes 3 columns starting with column A, headers in row1
- range to match your data

Excel 2016 (Windows) 32 bit
[Table="width:, class:head"][tr=bgcolor:#E0E0F0][th] [/th][th]
A​
[/th][th]
B​
[/th][th]
C​
[/th][th]
D​
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
1​
[/td][td]Order/priority[/td][td]Items[/td][td]Price[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
2​
[/td][td]
1​
[/td][td]A[/td][td]
100​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
3​
[/td][td]
2​
[/td][td]B[/td][td]
200​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
4​
[/td][td=bgcolor:#FFFF00]
3​
[/td][td=bgcolor:#FFFF00]C[/td][td=bgcolor:#FFFF00]
300​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
5​
[/td][td]
4​
[/td][td]D[/td][td]
550​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
6​
[/td][td]
5​
[/td][td]E[/td][td]
70​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
7​
[/td][td]
6​
[/td][td]F[/td][td]
20​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
8​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[/table][Table="width:, class:grid"][tr][td]Sheet: BEFORE[/td][/tr][/table]

Excel 2016 (Windows) 32 bit
[Table="width:, class:head"][tr=bgcolor:#E0E0F0][th] [/th][th]
A​
[/th][th]
B​
[/th][th]
C​
[/th][th]
D​
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
1​
[/td][td]Order/priority[/td][td]Items[/td][td]Price[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
2​
[/td][td=bgcolor:#FFFF00]
1​
[/td][td=bgcolor:#FFFF00]C[/td][td=bgcolor:#FFFF00]
300​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
3​
[/td][td]
2​
[/td][td]A[/td][td]
100​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
4​
[/td][td]
3​
[/td][td]B[/td][td]
200​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
5​
[/td][td]
4​
[/td][td]D[/td][td]
550​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
6​
[/td][td]
5​
[/td][td]E[/td][td]
70​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
7​
[/td][td]
6​
[/td][td]F[/td][td]
20​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
8​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[/table][Table="width:, class:grid"][tr][td]Sheet: AFTER[/td][/tr][/table]

Code goes in SHEET module (will not work in Module1,Module2 etc)
right-click on sheet tab \ View Code \ paste code into that window \ back to Excel with {ALT}{F11}
save workbook as macro enabled

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myRange As Range, newP As Double
    If Target.Count > 1 Then Exit Sub
    If Not IsNumeric(Target) Then Exit Sub
    Set myRange = Range("A2", Range("A" & Rows.Count).End(xlUp))
    If Not Intersect(Target, myRange) Is Nothing Then
        Application.EnableEvents = False
        newP = Target
        Target = WorksheetFunction.Max(myRange) + 1
        Call SortData(myRange)
        myRange(myRange.Rows.Count, 1) = newP - 0.5
        Call SortData(myRange)
        Application.EnableEvents = True
    End If
End Sub

Private Sub SortData(aRange As Range)
    Dim cel As Range
    Application.ScreenUpdating = False
    aRange.Resize(, 3).Sort aRange(1, 1), xlAscending
    For Each cel In aRange
        cel = cel.Row - 1
    Next
End Sub
 
Upvote 0
An alternative method

This assumes 3 columns starting with column A, headers in row1
Code goes in SHEET module (will not work in Module1,Module2 etc)
right-click on sheet tab \ View Code \ paste code into that window \ back to Excel with {ALT}{F11}
save workbook as macro enabled


Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range: Set Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
    Dim oldP As Long, newP As Double, Cel As Range
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Rng) Is Nothing Then
        On Error Resume Next
        Application.EnableEvents = False
            newP = Target
            Application.Undo
            oldP = Target
            Select Case newP
                Case Is < oldP: newP = newP - 0.5
                Case Is > oldP: newP = newP + 0.5
            End Select
            Target = newP
            Rng.Resize(, 3).Sort Rng(1, 1), xlAscending
            For Each Cel In Rng
                Cel = Cel.Row - 1
            Next
        Application.EnableEvents = True
    End If
End Sub
 
Upvote 0
Yongle said:
Welcome to the forum
It is possible to do what you want with VBA

Are there only 3 columns of data ?
Is each order/priority unique ?
(in other words - is every value in column A different to every other value in column A ?)
Is the data always sorted by priority ?
Click to expand...

Hello Yongle, apologies for the tardy response .

To answer your questions:
1. No, I have more than 3 columns, potentially over 30.
2. Yes, each position is unique, I don't want two items to share the same position value
3. Not always, but 95% of the time it will be so if that is an issue or a constraint of the code I have no problem sorting only by priority.

I've tried the first code you've provided and it seems to do what I am looking for.

My only question is concerning the amounts of columns: does it have to be specified in the code, or can the code work indifferently from the number of column so that if I had more over time (which could happen) it would still function properly?

Not sure if I can do it here but I'd be more than happy to provide my spreadsheet and give you more context if required.

Thank you so very much for your help! :biggrin:
 
Upvote 0
Hi Yongle,

I've adjusted the first code to take into account the following parameters and it seems to work pretty well:
- Data starts on row 13
- There are 30 columns in the spreadsheet

Here is the adjusted code. Thanks for your help!


Code: 
Private Sub Worksheet_Change(ByVal Target As Range)    Dim myRange As Range, newP As Double
    If Target.Count > 1 Then Exit Sub
    If Not IsNumeric(Target) Then Exit Sub
    Set myRange = Range("A13", Range("A" & Rows.Count).End(xlUp))
    If Not Intersect(Target, myRange) Is Nothing Then
        Application.EnableEvents = False
        newP = Target
        Target = WorksheetFunction.Max(myRange) + 1
        Call SortData(myRange)
        myRange(myRange.Rows.Count, 1) = newP - 0.5
        Call SortData(myRange)
        Application.EnableEvents = True
    End If
End Sub


Private Sub SortData(aRange As Range)
    Dim cel As Range
    Application.ScreenUpdating = False
    aRange.Resize(, 31).Sort aRange(1, 1), xlAscending
    For Each cel In aRange
        cel = cel.Row - 12
    Next
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Rank tasks in order of highest priority
Replies
3
Views
252
alansidman
alansidman
E
  • Question Question
Multiple questions for beginners
Replies
3
Views
315
excelnewlearner
E
B
  • Question Question
VBA/Macro (dynamic ranges) IF And Statement that uses interior color in column A and blank in column F
Replies
0
Views
692
blooeyez
B
J
  • Question Question
Priority Order - Rearrange in priority order help.
Replies
1
Views
346
Legacy 143009
L
E
  • Solved
Performance issue using a combination of dropdowns & lookups
Replies
9
Views
660
Akuini
Akuini

Forum statistics

Threads
1,224,817
Messages
6,181,148
Members
453,021
Latest member
Justyna P

Share this page

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