Updating Rank

I have a spreadsheet with column A ranking the info 1-100 for priority.  How 
can I change a row to move to the top and re-rank the rest?  The best example 
I have seen of this is your netflix queue where you ask it to move a 
selection to the top or re-rank numbers by changing where you want them in 
the queue.  I hope this makes sense.  Thanks!!
0
Utf
12/10/2009 1:33:01 PM
excel.misc 78881 articles. 5 followers. Follow

3 Replies
871 Views

Similar Articles

[PageSpeed] 48

'Right click on sheet tab, view code, paste this in:

'=====================================
Private Sub Worksheet_Change(ByVal Target As Range)
'Define Range that will be changed
If Intersect(Target, Range("A1:A100")) Is Nothing Or _
Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
'What is the new rank?
NewValue = Target.Value
Application.Undo
'What was the old rank?
OldValue = Target.Value

'Start re-ranking process
Target.Value = NewValue
For Each cell In Range("A1:A100")
'Find out if the rank needs to change
If cell.Value >= NewValue And _
Intersect(cell, Target) Is Nothing And _
cell.Value < OldValue Then
'If needed, move down in rank
cell.Value = cell.Value + 1
End If
Next cell
Application.EnableEvents = True
End Sub
'==========================

Exit out of the VBE, and your workbook should be good to go. Note that this 
only works for INCREASING the rank, not decreasing.
-- 
Best Regards,

Luke M
*Remember to click "yes" if this post helped you!*


"NSI Lynsy" wrote:

> I have a spreadsheet with column A ranking the info 1-100 for priority.  How 
> can I change a row to move to the top and re-rank the rest?  The best example 
> I have seen of this is your netflix queue where you ask it to move a 
> selection to the top or re-rank numbers by changing where you want them in 
> the queue.  I hope this makes sense.  Thanks!!
0
Utf
12/10/2009 4:13:01 PM
Thanks Luke, I will give it a try

"Luke M" wrote:

> 'Right click on sheet tab, view code, paste this in:
> 
> '=====================================
> Private Sub Worksheet_Change(ByVal Target As Range)
> 'Define Range that will be changed
> If Intersect(Target, Range("A1:A100")) Is Nothing Or _
> Target.Count > 1 Then Exit Sub
> Application.EnableEvents = False
> 'What is the new rank?
> NewValue = Target.Value
> Application.Undo
> 'What was the old rank?
> OldValue = Target.Value
> 
> 'Start re-ranking process
> Target.Value = NewValue
> For Each cell In Range("A1:A100")
> 'Find out if the rank needs to change
> If cell.Value >= NewValue And _
> Intersect(cell, Target) Is Nothing And _
> cell.Value < OldValue Then
> 'If needed, move down in rank
> cell.Value = cell.Value + 1
> End If
> Next cell
> Application.EnableEvents = True
> End Sub
> '==========================
> 
> Exit out of the VBE, and your workbook should be good to go. Note that this 
> only works for INCREASING the rank, not decreasing.
> -- 
> Best Regards,
> 
> Luke M
> *Remember to click "yes" if this post helped you!*
> 
> 
> "NSI Lynsy" wrote:
> 
> > I have a spreadsheet with column A ranking the info 1-100 for priority.  How 
> > can I change a row to move to the top and re-rank the rest?  The best example 
> > I have seen of this is your netflix queue where you ask it to move a 
> > selection to the top or re-rank numbers by changing where you want them in 
> > the queue.  I hope this makes sense.  Thanks!!
0
Utf
12/10/2009 5:06:02 PM
Thanks Luke it worked like a charm.  Is there a way to automate so that once 
the numbers change, it would then sort again so 1 is at the top???
Your my Hero!

"Luke M" wrote:

> 'Right click on sheet tab, view code, paste this in:
> 
> '=====================================
> Private Sub Worksheet_Change(ByVal Target As Range)
> 'Define Range that will be changed
> If Intersect(Target, Range("A1:A100")) Is Nothing Or _
> Target.Count > 1 Then Exit Sub
> Application.EnableEvents = False
> 'What is the new rank?
> NewValue = Target.Value
> Application.Undo
> 'What was the old rank?
> OldValue = Target.Value
> 
> 'Start re-ranking process
> Target.Value = NewValue
> For Each cell In Range("A1:A100")
> 'Find out if the rank needs to change
> If cell.Value >= NewValue And _
> Intersect(cell, Target) Is Nothing And _
> cell.Value < OldValue Then
> 'If needed, move down in rank
> cell.Value = cell.Value + 1
> End If
> Next cell
> Application.EnableEvents = True
> End Sub
> '==========================
> 
> Exit out of the VBE, and your workbook should be good to go. Note that this 
> only works for INCREASING the rank, not decreasing.
> -- 
> Best Regards,
> 
> Luke M
> *Remember to click "yes" if this post helped you!*
> 
> 
> "NSI Lynsy" wrote:
> 
> > I have a spreadsheet with column A ranking the info 1-100 for priority.  How 
> > can I change a row to move to the top and re-rank the rest?  The best example 
> > I have seen of this is your netflix queue where you ask it to move a 
> > selection to the top or re-rank numbers by changing where you want them in 
> > the queue.  I hope this makes sense.  Thanks!!
0
Utf
12/10/2009 8:43:01 PM
Reply:

Similar Artilces: