increase cell value by 1

justme

Well-known Member
Joined
Aug 26, 2002
Messages
722
What I have is a list of items which are ranked in ascending order in column C. What I want to do is to be able to easily add line items that would require a mass re-ranking of the items which come after it.

The rows are not [necessarily] in ascending order by rank.

I would like to press a button that says re-rank. Then an input box would come up and say something like what items need to be re-ranked? and then I would enter the rank of the new line item - say it is number 5. Now all the existing line items that are ranked 5 or higher will increase in value by 1. Is this possible?

There are rows with no information that will be in the worksheet, so if there is no info in column c it should remain blank.

I hope this is a little clearer than mud....
 

Some videos you may like

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

SydneyGeek

MrExcel MVP
Joined
Aug 5, 2003
Messages
12,251
Place this code in a new module (Alt + F11, Insert > Module, paste, then Alt + Q to return to Excel)

To run, press Alt + F8 and double-click the macro name. Or, you can assign it to a button...

View > Toolbars > Forms Toolbar.
Click the commandButton icon, draw the button where you want it on the worksheet.
When the dialog pops up, double-click the macro name to assign it to the button.
When the dialog closes, change the caption on the button.

Denis
 

sunnyland

Well-known Member
Joined
Jan 27, 2006
Messages
912
Hello, try this

Sub rerank()
Dim mysheet As Worksheet
'CHANGE SHEET1 TO WHATEVER name
Set mysheet = Worksheets("Sheet1")
mysheet.Activate

Dim rerank As Integer
rerank = InputBox("Please Enter FROM which ranking you wish to increase value by one")
If IsNumeric(rerank) Then
'find the last cell in c with data
lastcellinC = Range("c65536").End(xlUp).Row
'string to hold the range reference of cells with rank higher than 5
Dim myref As String
'loop through each cell in C and if rank in higher then 5
For Each ran In Range("c1:c" & lastcellinC)
If VarType(ran) <> vbEmpty And IsNumeric(ran.Value) Then
If WorksheetFunction.Rank(ran, Columns("c").Cells, 1) >= rerank Then
myref = myref & "," & ran.Address
End If
End If
Next
'remove the first comma in references
If Left(myref, 1) = "," Then
myref = Mid(myref, 2)
End If
'if ranking range exist then increase by one
If Len(myref) > 0 Then
Range(myref).Select
For Each ran In Range(myref)
ran.Value = ran + 1
Next
Else
MsgBox "No ranking higher then " & fromrank & " was found"
End If
End If


End Sub
 

SydneyGeek

MrExcel MVP
Joined
Aug 5, 2003
Messages
12,251
Oops ... :oops:

Forgot the code ...
Code:
Sub ChangeRank()
    Dim intStart As Integer
    Dim c As Range
    
    intStart = CInt(InputBox("What is the start point for changing rank?"))
    For Each c In Range("C:C").SpecialCells(xlCellTypeConstants, xlNumbers)
        If c.Value >= intStart Then c.Value = c.Value + 1
    Next c
End Sub
Denis
 

justme

Well-known Member
Joined
Aug 26, 2002
Messages
722
Absolutely excellent!!

Thank you both for your answers. The code is working beautifully!
 

Watch MrExcel Video

Forum statistics

Threads
1,114,061
Messages
5,545,763
Members
410,704
Latest member
Cobber2008
Top