Const NROWS = 4, NCOLS = 5
Const MAX_INT = &h7FFFFFFF

Dim Shared As Integer supply(NROWS-1) = {50, 60, 50, 50}
Dim Shared As Integer demand(NCOLS-1) = {30, 20, 70, 30, 60}
Dim Shared As Integer costs(NROWS-1, NCOLS-1), results(NROWS-1, NCOLS-1)
Dim Shared As Boolean rowDone(NROWS-1), colDone(NCOLS-1)

Sub calcDiff(j As Integer, l As Integer, isRow As Boolean, diff() As Integer)
    Dim As Integer min1 = MAX_INT, min2 = MAX_INT, minP = -1

    For i As Integer = 0 To l-1
        Dim As Boolean done = Iif(isRow, colDone(i), rowDone(i))

        If done Then Continue For

        Dim As Integer c = Iif(isRow, costs(j, i), costs(i, j))

        If c < min1 Then
            min2 = min1
            min1 = c
            minP = i
        Elseif c < min2 Then
            min2 = c
        End If
    Next

    diff(0) = min2 - min1
    diff(1) = min1
    diff(2) = minP
End Sub

Sub maxPenalty(len1 As Integer, len2 As Integer, isRow As Boolean, result() As Integer)
    Dim As Integer md = -MAX_INT
    Dim As Integer pc = -1, pm = -1, mc = -1
    Dim As Integer diff(2)

    For i As Integer = 0 To len1-1
        Dim As Boolean done = Iif(isRow, rowDone(i), colDone(i))

        If done Then Continue For

        calcDiff(i, len2, isRow, diff())
        If diff(0) > md Then
            md = diff(0)
            pm = i
            mc = diff(1)
            pc = diff(2)
        End If
    Next

    If isRow Then
        result(0) = pm : result(1) = pc : result(2) = mc : result(3) = md
    Else
        result(0) = pc : result(1) = pm : result(2) = mc : result(3) = md
    End If
End Sub

Sub nextCell(cell() As Integer)
    Dim As Integer i, res1(3), res2(3)

    maxPenalty(NROWS, NCOLS, True, res1())
    maxPenalty(NCOLS, NROWS, False, res2())

    If res1(3) = res2(3) Then
        If res1(2) < res2(2) Then
            For i = 0 To 3
                cell(i) = res1(i)
            Next
        Else
            For i = 0 To 3
                cell(i) = res2(i)
            Next
        End If
    Elseif res1(3) > res2(3) Then
        For i = 0 To 3
            cell(i) = res2(i)
        Next
    Else
        For i = 0 To 3
            cell(i) = res1(i)
        Next
    End If
End Sub

' Main program
costs(0,0)=16 : costs(0,1)=16 : costs(0,2)=13 : costs(0,3)=22 : costs(0,4)=17
costs(1,0)=14 : costs(1,1)=14 : costs(1,2)=13 : costs(1,3)=19 : costs(1,4)=15
costs(2,0)=19 : costs(2,1)=19 : costs(2,2)=20 : costs(2,3)=23 : costs(2,4)=50
costs(3,0)=50 : costs(3,1)=12 : costs(3,2)=50 : costs(3,3)=15 : costs(3,4)=11

Dim As Integer i, j, supplyLeft = 0
For i = 0 To NROWS-1
    supplyLeft += supply(i)
Next

Dim As Integer totalCost = 0
Dim As Integer cell(3)

While supplyLeft > 0
    nextCell(cell())
    Dim As Integer r = cell(0), c = cell(1), q = demand(c)
    If q > supply(r) Then q = supply(r)

    demand(c) -= q
    If demand(c) = 0 Then colDone(c) = True

    supply(r) -= q
    If supply(r) = 0 Then rowDone(r) = True

    results(r, c) = q
    supplyLeft -= q
    totalCost += q * costs(r, c)
Wend

Print "    A   B   C   D   E"
For i = 0 To NROWS-1
    Print Chr(Asc("W") + i);
    For j = 0 To NCOLS-1
        Print Using "  ##"; results(i, j);
    Next
    Print
Next

Print !"\nTotal cost = "; totalCost

Sleep