# increase cell value by 1

#### justme

##### Well-known Member
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....

### 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
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
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
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
Absolutely excellent!!

Replies
3
Views
58
Replies
3
Views
139
Replies
6
Views
117
Replies
12
Views
292
Replies
11
Views
142