Home » excel » excel – Prioritization of projects VBA

excel – Prioritization of projects VBA

Posted by: admin May 14, 2020 Leave a comment


I have a list of 30 projects displayed in lines, I need to give the user the possibility to change the priority of projects on VBA form.

The form is fine, the user can look for the project he wants (by clicking on look for project), the Old priority is filled automatically and he is asked to type the new priority:

enter image description here

By Clicking on OK, the new priority for that project should substitute the old priority for that project and it should re order everything on priority column.

The code I have almost works, but it leaves a whole, in the example below, I change the project with priority 3 to priority 10, it changed the whole column, but it disappeared with project priority 3:

enter image description here

This is the code I have:

(It is really messy and I can´t figure out a way to make it work)

' After clicking on look for project , where cell focus in on the project he wants to change priority

Private Sub CommandButton1_Click()
Dim old_priority As String
Dim CELL As Range

ActiveCell.Offset(0, -1).Select
ActiveCell.Value = new_priority.Text

For Each CELL In Range("b8:b36")

   If CELL.Value >= new_priority.Text + 1 Then
   CELL.Value = CELL.Value + 1
   End If

   If CELL.Value = new_priority.Text Then
   CELL.Value = CELL.Value + 1
   End If


   ThisWorkbook.Sheets("sheet5").Range("c27").Value = new_priority.Text

    Cells.Find(What:=ThisWorkbook.Sheets("sheet5").Range("b27").Value, After:=ActiveCell, LookIn:=xlFormulas, _
       LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False).Activate
    Prioridade.Text = ActiveCell.Offset(0, -1).Value
    ActiveCell.Offset(0, -1).Select
    ActiveCell.Value = new_priority.Text

        Unload Me

End sub

I am sure there is an easier way to loop throught the cells and re order the list.

How to&Answers:

Imagine the following data, where we want to change priority 3 into 10 (which already exists) so it shoult be sorted right before 10.

enter image description here

Then we use the following code:

Option Explicit

Public Sub Test()
    ReOrder OldPriority:=3, NewPriority:=10
End Sub

Public Sub ReOrder(OldPriority As Long, NewPriority As Long)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Tabelle9")

    Dim MatchRow As Double
    On Error Resume Next
        MatchRow = Application.WorksheetFunction.Match(OldPriority, ws.Columns("A"), 0)
    On Error GoTo 0

    If MatchRow = 0 Then
        MsgBox "The old priority number did not exist.", vbCritical
        Exit Sub
    End If

    'write new priorty
    ws.Cells(MatchRow, "A").Value = NewPriority - 0.001 'subtract a small number so it will always sort before existing priorities

    'sort by priortiy
    With ws.Sort
        .SortFields.Add2 Key:=ws.Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange ws.Range("A:B") 'your data range
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
    End With

    'rewrite priority numbers ascending
    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    Dim iRow As Long
    For iRow = 2 To LastRow
        ws.Cells(iRow, "A") = iRow - 1
    Next iRow
End Sub

After the new priorirty was written and the data was sorted by priority it looks like this:

enter image description here

So we just need to rewrite the numbers and we end up here:

enter image description here