Sorting a complex array using a scheduling algorithm 1

[gal4y]

If anyone could help me I would appreciate it. I need to sort an the array below first by priming and painting times together. Meaning there will be an 8 dimesional array.

I have the following data in Excel:
Type of Vehicle Priming Time Painting Time
a 1.25 1.75
b 0.60 0.70
c 1.10 1.45
d 1.00 0.70


0.60 first and 1.75 last keeping track of whether the times were taken from painting or priming. I need to do this to put the vehicles in a special order using the following algorithm:

IF the smallest time (0.60 for example) in priming then it is the first vehicle.
If the smallest time is in painting it goes last.
IF the next smallest time is in priming it is the next vehicle. If the next smallest time is in painting move to Last-1. And so on until you run out of vehicles.

Output should be the name of the vehicle in an array where i= 1 to 4. 1=first and 2=last


I loaded the data using the following code:

For i = 1 To 4
'Load Priming_Painting information
NPriming(i) = ActiveSheet.Cells(i + 4, 2).Value
PrimingTime(i) = ActiveSheet.Cells(i + 4, 3).Value
PaintingTime(i) = ActiveSheet.Cells(i + 4, 4).Value

Next i

I then inputted into a 8 dimesional array.

Dim First As Integer, Last As Integer

First = LBound(PrimingTime)
Last = UBound(PrimingTime)

Dim Timelist(8, 8) As Double
Dim Namelist(8, 8) As String
i = 0
For i = 1 To Last

Timelist(i, 1) = PrimingTime(i)
Timelist(i + 4, 2) = PaintingTime(i)
Namelist(i, 1) = NPriming(i)
Namelist(i + 4, 2) = NPriming(i)
Next i

But now having problems sorting and eventually condensing to a array of 4 elements in that sort order.

Can anyone help?
Thank you in advance

Greg

 

[MichaelRed]

I guess there is much I don't understand. "Looks Like" (at least to me) that a simple ywo level sort works quite nicely. Sort (Asc) on Priming time, then (for equal priming times), sort (Desc) on Painting Times. So, why do the need for an eight dimensional array?

Next is the trivial but confpounding need to have a Vehicle Name in the 'answer', when it does not seem to appear in the 'question'. Of course, I would assume that it is just a 'typo', and you actually mean ehicle Type?



MichaelRed
m.red@att.net

Searching for employment in all the wrong places

 

[VBAjedi]

Ok, I'm having a hard time seeing why you are using the approach you describe. Sounds like you are trying to determine the most efficient order to run items through a two-step process. I'd like further info:

1) Are the two processes seperate? In other words, does the car roll into the priming booth, then when priming is done join a line for the painting booth? Or does the car roll into the booth and get primed and painted before it leaves the booth? And if they are seperate, which process takes longer on average (since that will determine which process most needs optimization)?

2) Again, if the processes are seperate: Say your primers (step 1) are faster than your painters (step 2), so a "waiting" line develops before step 2. Must your painters do the vehicle that has been waiting the longest next? Or can they do them in any order?

I'm sure we can help you come up with a great solution once we see what you are after. . .


VBAjedi

 

[gal4y]

There is something called "Johnson's Algorithm" that I am trying to implement using VBA. There are follow-on spreadsheets that are only useful if I know the order the vehicles are supposed to go through the priming/painting stages as an array (example: a,b,c,d or b,d,c,a, etc.).

Johnson's algorithm says for a two stage process that for the following set of data:
Name Prime(time) Paint(time)
a 1.25 1.75
b 0.60 0.70
c 1.10 1.45
d 1.00 0.70

The order of the vehicles through the two stages will be: b,c,a,d because
b is first because it has 0.60 (best PrimeTime goes first),
d is last because it has 0.70 (tied with b but b has a place in the array; it has the next best time but it for the second stage),
c is next because it has the next best time after 1.00 (for d but has been placed) =1.10 for the 1st stage time,
a is third because it is left.

For this example: b is placed in the last position first because it has the best time but it is a second stage time, d is placed next in the 3rd position, then c is placed in the first position (1.10 next best time and a first position time), a is put in the 2nd position for an overall answer of: c,a,d,b.

Name Prime(time) Paint(time)
a 1.25 1.75
b 0.60 0.50
c 1.10 1.45
d 1.00 0.70

Overall if the best time is in the first stage (time column; priming time) then you fill the array (name array) from the left and if it is in the second stage (time column; Paint time) then you fill the array (name array) from the right.

I hope that clears it up
Thanks again for your assistance
Greg

 

[VBAjedi]

Ok, I think I get it. Very interesting!

This was harder than it looked (took me WAY too long to figure out!), and I think the code could be optimized quite a bit, but this works (at least on your sample data). Note that you need to set the range you want to look in, and the code currently assumes the names are in column "A":

Sub JohnsonArray()
Dim PArray(4, 100)
Dim Names(2, 100)
Dim Order(100)
Dim TimesRange As Range
Dim i, j, x, y, z


' Load PArray with times
Set TimesRange = Range("B2:C5")
FirstCol = TimesRange.Column
x = 0
For Each C In TimesRange
   x = x + 1
   PArray(1, x) = Range("A" & C.Row).Value ' Assumes names are in column A
   PArray(2, x) = C.Value ' Prep Time
   If C.Column = FirstCol Then ' Time is for step 1
      PArray(3, x) = 1 ' Flag as step 1 time
   Else
      PArray(3, x) = 2 ' Flag as step 2 time
   End If
   PArray(4, x) = C.Row ' used as foreign index to Names array
Next

' Load Names, using Row as index
For y = 1 To TimesRange.Rows.Count
   z = TimesRange.Rows(y).Row
   Names(1, z) = Range("A" & z).Value
Next y

' Now sort PArray based on 2nd dimension
For i = 1 To x
    If PArray(2, i - 1) > PArray(2, i) Then
        j = i
        While j > 0
            If PArray(2, j - 1) > PArray(2, j) Then
                Temp1 = PArray(1, j)
                Temp2 = PArray(2, j)
                Temp3 = PArray(3, j)
                Temp4 = PArray(4, j)
                PArray(1, j) = PArray(1, j - 1)
                PArray(2, j) = PArray(2, j - 1)
                PArray(3, j) = PArray(3, j - 1)
                PArray(4, j) = PArray(4, j - 1)
                PArray(1, j - 1) = Temp1
                PArray(2, j - 1) = Temp2
                PArray(3, j - 1) = Temp3
                PArray(4, j - 1) = Temp4
            Else
                j = 0
            End If
            j = j - 1
        Wend
    End If
Next i

' Now fill Order array
TDownPointer = 1
BUpPointer = TimesRange.Rows.Count
For i = 1 To x ' Loop through PArray
   If Len(Names(2, PArray(4, i))) = 0 Then ' Name hasnt been placed yet
      If PArray(3, i) = 1 Then ' is a step 1 time
         Order(TDownPointer) = PArray(1, i)
         TDownPointer = TDownPointer + 1
      Else
         Order(BUpPointer) = PArray(1, i)
         BUpPointer = BUpPointer - 1
      End If
      Names(2, PArray(4, i)) = "Placed"
   End If
Next i

' Print sorted PArray and resulting Order array to Immediate window
For i = 1 To x
   Debug.Print PArray(1, i) & ", " & PArray(2, i) & ", " & PArray(3, i) & ", " & PArray(4, i)
Next i
For i = 1 To TimesRange.Rows.Count
   Debug.Print Order(i)
Next i

End Sub

You end up with the results you want in the Order array.

Let me know if it works on a larger data sample. I was concerned that the BUpPointer and TDownPointer would clash when they met in the middle, but they don't seem to. . .

VBAjedi