implementing an algorithm in VBA

[eaje92]

Hi all! i know this is a bit hard and far fetch. But i was wondering if there is a way to implement this algorithm into vba to pick a job for process

1. enumerate jobs such that d1 ≤ . . . ≤ dn;
2. S1 := ∅; t := 0;
3. FOR j:=1 TO n DO
4. S1 := S1 ∪ {j}; t := t + pj;
5. IF t > dj THEN
6. Find job k with largest pk value in S1;
7. S1 := S1 \ {k}; t := t − pk;
8. END
9. END

The main idea is we have 4 columns with the number of jobs

[TABLE="width: 500"]
<tbody>[TR]
[TD]Job number[/TD]
[TD]Processing time [/TD]
[TD]Due Date[/TD]
[TD]Completion date[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]2[/TD]
[TD]8[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]1[/TD]
[TD]4[/TD]
[TD]3 = (2+1)[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]3[/TD]
[TD]6[/TD]
[TD]6 = (3+3)[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]4[/TD]
[TD]7[/TD]
[TD]10= (6+4)[/TD]
[/TR]
</tbody>[/TABLE]

The jobs are first sorted by due date in ascending order and checked if the job is late (completion date < due date)

[TABLE="width: 500"]
<tbody>[TR]
[TD]Job number[/TD]
[TD]Processing time [/TD]
[TD]Due Date[/TD]
[TD]Completion Date[/TD]
[TD]Late?[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]1[/TD]
[TD]4[/TD]
[TD]1[/TD]
[TD]No[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]3[/TD]
[TD]6[/TD]
[TD]4 (1+3)[/TD]
[TD]No[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]4[/TD]
[TD]7[/TD]
[TD]8 (4+4)[/TD]
[TD]Yes[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]2[/TD]
[TD]8[/TD]
[TD]10 (2+8)[/TD]
[TD]Yes[/TD]
[/TR]
</tbody>[/TABLE]

From the first 3 jobs (earliest late job to the top), remove the longest duration job, keeping it seperate

[TABLE="width: 500"]
<tbody>[TR]
[TD]Job number[/TD]
[TD]Processing time [/TD]
[TD]Due Date[/TD]
[TD]Completion Date[/TD]
[TD]Late?[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]1[/TD]
[TD]4[/TD]
[TD]3[/TD]
[TD]No[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]3[/TD]
[TD]6[/TD]
[TD]6[/TD]
[TD]No[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]2[/TD]
[TD]8[/TD]
[TD]2[/TD]
[TD]Yes

[/TD]
[/TR]
</tbody>[/TABLE]

Repeat steps to see if last job is late.

[TABLE="width: 500"]
<tbody>[TR]
[TD]Job number[/TD]
[TD]Processing time [/TD]
[TD]Due Date[/TD]
[TD]Completion Date[/TD]
[TD]Late?[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]1[/TD]
[TD]4[/TD]
[TD]1[/TD]
[TD]No[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]3[/TD]
[TD]6[/TD]
[TD]4(1+3)[/TD]
[TD]No[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]2[/TD]
[TD]8[/TD]
[TD]6(4+2)[/TD]
[TD]No[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]

[/TD]
[/TR]
</tbody>[/TABLE]

Once all jobs are not late, add the seperated jobs back

[TABLE="width: 500"]
<tbody>[TR]
[TD]Job number[/TD]
[TD]Processing time [/TD]
[TD]Due Date[/TD]
[TD]Completion Date[/TD]
[TD]Late?[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]1[/TD]
[TD]4[/TD]
[TD]1[/TD]
[TD]No[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]3[/TD]
[TD]6[/TD]
[TD]4(1+3)[/TD]
[TD]No[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]2[/TD]
[TD]8[/TD]
[TD]6(4+2)[/TD]
[TD]No[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]4[/TD]
[TD]7[/TD]
[TD]10 (6+4)[/TD]
[TD]Yes

[/TD]
[/TR]
</tbody>[/TABLE]

This would be the sequence the jobs would be process 2-3-1-4.

help greatly appreciated

 

[PhilS2520]

Hi eaje92

Clearly you understand logical thinking, so now all you need is to learn the VBA syntax and you will all be set to write your own code.

First start by recording some code. Activate the Developer Tab in Excel 2016, or whatever version you are using, start the recorder and then look at the code.

You could also use your favorite search engine to find the missing parts. Mind you the recorder will add some extra code that you may not need for your tasks.

Hope this helps.

 

[eaje92]

Hi eaje92

Clearly you understand logical thinking, so now all you need is to learn the VBA syntax and you will all be set to write your own code.

First start by recording some code. Activate the Developer Tab in Excel 2016, or whatever version you are using, start the recorder and then look at the code.

You could also use your favorite search engine to find the missing parts. Mind you the recorder will add some extra code that you may not need for your tasks.

Hope this helps.

Thanks for your reply! I do understand a little of vba syntax. This is what i currently have

Sub sort()


Dim oneRange As Range
Dim aCell As Range
Dim Currenttime As Double
Dim processtime As Double
Dim completiontime As Double
Dim i As Long
Dim jobno As Integer


'This sorts the list of jobs in terms of Due Date
Set oneRange = Range("B1:D2001")
Set aCell = Range("D1")


oneRange.sort Key1:=aCell, Order1:=xlAscending, Header:=xlYes

'This finds the number of jobs in the list for iterative calculation for completion time

jobno = Range("M3").Value

'This calculates the completion time and records it in the column beside
For i = 1 To jobno


Currenttime = Range("I2").Value
processtime = Application.Sum(Range("C2" & ":C" & i + 1))

completiontime = Currenttime + processtime


Range("E1").Offset(i, 0) = completiontime


Next i


End Sub

I am currently stuck in the part to locate the job with the longest processing time and removing it to the back of the sequence. Any advise?

 

[wideboydixon]

Starting point:

Book1
	A	B	C
1	Job number	Processing time	Due Date
2	1	2	8
3	2	1	4
4	3	3	6
5	4	4	7
Sheet1

Executed macro:

Public Sub ScheduleJobs()

Dim lastRow As Long
Dim thisRow As Long
Dim timeTaken As Long
Dim removeRow As Long
Dim searchRow As Long
Dim maxTime As Long
Dim nextRow As Long

' Find the last row
lastRow = Cells(Rows.Count, "A").End(xlUp).Row

' Remember the next row where we'll move things to
nextRow = lastRow + 1

' Sort by due date
With ActiveSheet.Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range("C2:C" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .SetRange Range("A1:C" & lastRow)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

' Start scheduling on row 2
thisRow = 2

' Accumulate the time taken
timeTaken = 0

' Process all rows
Do While thisRow <= lastRow
    ' Add on the time taken for this job
    timeTaken = timeTaken + Cells(thisRow, "B").Value
    
    ' Will it make this job late?
    If timeTaken > Cells(thisRow, "C").Value Then
        ' Find the job with the highest processing time
        maxTime = 0
        For searchRow = 2 To thisRow
            If Cells(searchRow, "B").Value > maxTime Then
                maxTime = Cells(searchRow, "B").Value
                removeRow = searchRow
            End If
        Next searchRow
        
        ' Did we find a job?
        If maxTime > 0 Then
            ' Yes - move the row to the bottom
            Cells(removeRow, "A").EntireRow.Cut
            Cells(nextRow, "A").EntireRow.Insert Shift:=xlDown
            Application.CutCopyMode = False
            
            ' Reduce the time taken by this value
            timeTaken = timeTaken - maxTime
            
            ' Change the last row
            lastRow = lastRow - 1
        Else
            ' Move to the next row
            thisRow = thisRow + 1
        End If
    Else
        ' Move to the next row
        thisRow = thisRow + 1
    End If
Loop

' Populate two final columns
lastRow = nextRow - 1
Range("D1").Value = "Completion date"
Range("E1").Value = "Late?"
Range("D2:D" & lastRow).Formula = "=N(D1)+B2"
Range("E2:E" & lastRow).Formula = "=IF(D2<=C2,""No"",""Yes"")"

End Sub

Final result:

Book1
	A	B	C	D	E
1	Job number	Processing time	Due Date	Completion date	Late?
2	2	1	4	1	No
3	3	3	6	4	No
4	1	2	8	6	No
5	4	4	7	10	Yes
Sheet1

Cell Formulas
Range	Formula
D2	=N(D1)+B2
E2	=IF(D2<=C2,"No","Yes")

WBD