user-defined type, array, looping

ethan211
ethan211 used Ask the Experts™
on
I have found this code in the database.  I have a user defined type which I established as an array.

----------------------------------------------------
Private Type ScheduleStructure
   lngFlightNum As Long          '1 - 4
   strName As String
   lngClass As Long                   '1 - 3
   lngSeatsToReserve As Long          '1 - 6
End Type

Dim udtFlightSchRecord ( ) As ScheduleStructure
Dim udtCurrentRecord As ScheduleStructure

'Array looks like:
1, john, 3, 6
2, moses, 1, 6
4, james, 4, 6

third column is the different Class # (1 – 3)
         If I chose class 1, there will be 2 seat available
         If I chose class 2, there will be 4 seat available
         If I chose class 3, there will be 6 seat available

----------------------------------------------------

I need help in cycling through each flight (1 –4) and assign the seat.  If the seat is unavailable,  I will have to send the request (assign a seat) to another airplane which has a different class requirement (for example: class 3 has only 2 seats available.
 
FOR intArrayLoop = LBound(udtFlightRecord) to UBOUND(udtFlightRecord)
     udtCurrentRecord = udtFlightRecord(intArrayLoop)
     FOR EACH udtCRecord.lngNum
        SELECT CASE udtCurrentRecord.lngClass
                CASE 1
                 lngNumSeatsAvailable = 2
                CASE 2
                  lngNumSeatsAvailable = 4
           CASE 3
                 lngNumSeatsAvailable = 6
        END SELECT
     NEXT

     IF udtCurrentRecord.lngSeatsToReserve > 0 THEN
          IF udtCurrentRecord.lngSeatsToReserve <= lngNumSeatsAvailable THEN
       lstDisplay.AddItem udtFlightSchRecord (intArray).lngFlightNum
               lstDisplay.ItemData (lstDisplay.NewIndex) = intCnt
                 lngNumSeatsAvailable = lngNumSeatsAvailable -1
          ELSE
                    'MsgBox error message
                 'Switch to another airplane to fullfill request
          ENDIF
   ENDIF

NEXT
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
See the comments ### where I suggest changes.

Read me comments on the next post.

Dim udtFlightSchRecord() As ScheduleStructure

' ### you don't needs this
'Dim udtCurrentRecord As ScheduleStructure

Dim RC As Long  ' record count

' ### the array name was wrong
For RC = LBound(udtFlightSchRecord) To UBound(udtFlightSchRecord)

    ' ### dont need this it just slows things up.
    '    udtCurrentRecord = udtFlightRecord(intArrayLoop)
    'FOR EACH udtCRecord.lngNum
       Select Case udtFlightSchRecord(RC).lngClass
               Case 1
                    lngNumSeatsAvailable = 2
               Case 2
                    lngNumSeatsAvailable = 4
                Case 3
                    lngNumSeatsAvailable = 6
       End Select
    Next

    If udtFlightSchRecord(RC).lngSeatsToReserve > 0 Then
         If udtFlightSchRecord(RC).lngSeatsToReserve <= lngNumSeatsAvailable Then
              lstDisplay.AddItem udtFlightSchRecord(RC).lngFlightNum
              lstDisplay.ItemData(lstDisplay.NewIndex) = RC
              ' ### think this should records by no seats
              lngNumSeatsAvailable = lngNumSeatsAvailable - udtFlightSchRecord(RC).lngSeatsToReserv
         Else
                   'MsgBox error message
                'Switch to another airplane to fullfill request
         End If
  End If

Next
You've got quite a mess there ethan...
Your biggest problem is that you aren't being consistent with the names of your variables. For example, in one place you use "udtCurrentRecord" and in another you use "udtCRecord". This doesn't work.

Do this before you do anything else- In the "Tools" menu click on "Options...". In there check the "Require Variable Decleration" (in the "code settings" box). Then make sure that you have the phrase "Option Explicit" at the top of the code. If it's not there, add it.
This will make sure that you define your variables and will not let you run your code otherwise.

Next, I had a little trouble understanding what it is you are doing. Your loop through the flights is ok (using LBound and UBound).
"FOR EACH udtCRecord.lngNum" doesn't work because "For Each" is not meant to loop through arrays of UDTs.

The "intCnt" variable stumped me. What is that supposed to be?

Hope this helps a bit, keep up the good work and don't hesitate to ask for further assistance.

Monchanger
Do not realy see what you are trying to do but.  For this type of job you can also use a Class module "Project Add Class Module".  You can then do thinks like this:

------Class Modudle: clsFlight.cls

Option Explcit

Public Number as String
Public ClassSeats

------Class Modudle: clsPax.cls

Option Explcit

Public FlightNumber as String
Public PaxMame as String
Public SeatsToReserve as Long
Public ClassReq as Long
Public Allocated as Boolean

In your form you can now say things like:

Dim Flights As New Collection

Dim Flight as clsFlight
Set Flight = New clsFlight
Flight.Number = xxxx

' make classseats into an array
Dim Seats
Set Seats = Flight.ClassSeats
Seats= Array(0)
Redim Seats(3)
Seats(1)=20 ' this changes Flight.ClassSeats(1)
Seats(2)=30
Seats(3)=50

Flights.Add Flight, Flight.Number

' now setup details for next flight etc.

etc...

' Now create a list of Pax

Dim Passwngers as New Collection
Dim Pax as New clsPax

' How to add a passanger to the collection
Set Pax = New clsPax
Pax.FlightNumber=xx
Pax.PaxName =xx
Pax.SeatsToReserve=xx
Pax.ClassReq = 1
Pax.Allocated = False
Pax.PaxID = xx ' a record number in a database for example

Passengers.Add Pax, CSTR(Pax,PaxID)


Now you can do things like allocate seats:

For Each Pax In Passengers
    Set Flight = Flights(Pax.FlighNumber)
    TryToAllocate Pax,Flight, Pax.ClassReq ' see sub code below
Next

Now you can try to allocated the pax who could not be allocated onto same class on a different flight:

For Each Pax In Passengers
   If Pax.Allocated = False Then
       For Each Flight in Flights
           TryToAllocate Pax,Flight, Pax.ClassReq
           If Pax.Allocated then Exit For
       next
   End If
Next

Now you see if pax can travel on same flight different class

For Each Pax In Passengers
   If Pax.Allocated = False Then
       For ClassCount = 1  to 3
           Set Flight = Flights(Pax.FlightNumber)
           TryToAllocate Pax,Flight, ClassCount
               If Pax.Allocated then
                   Pax.ClassReq=ClassCount
                   Exit For
               End If
           Next
   End If
 Next

Now you can allocate the pax who are left on any class on any flight

For Each Pax In Passengers
   If Pax.Allocated = False Then
       For Each Flight in Flights
           For ClassCount = 1  to 3
               TryToAllocate Pax,Flight, ClassCount
               If Pax.Allocated then ' sucess
                   ' change lfight and class
                   Pax.FlightNumber=Flight.Number
                   Pax.ClassReq=ClassCount
                   Exit For
               End If
           Next
           If Pax.Allocated then
              Exit For
           End If
      next  
   End If
Next


Now we can get a list of the people who are screwed:

Dim Screwed as New Collection
For Each Pax In Passengers
   If Pax.Allocated = False Then
       Screwed.Add Pax, Cstr(Pax.PaxID)
   End If
Next

Sub TryToAllocate(Pax as clsPax, Flight as clsFlight,ClassReq)
    ' try to allocate pax onto a flight
    If Pax.SeatsToReserve<=Flight.ClassSeats(ClassReq) Then
       Flight.ClassSeats(ClassReq) =        Flight.ClassSeats(ClassReq) - Pax.SeatsToReserve
       Pax.Allocated=True
    End If
End Sub


Hope this helps and you get the drift :~)
Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

It might not surprise you to know that I do some work for the F1 Grand Prix hotel & flight allocation department of a major travel office.

Author

Commented:
Inthedark,

I have a vague understanding of collections.  Is there anyway you can rewrite the above example using another method?  I understand user defined variable "Private Type Statements" and arrays very well. Thanks for any help.
No becuase it would be the wrong way to go.....
The reason why you need Collections is that a collection does an automated search and find. User defined types is what you know about:

Private Type CarDef
    ID as Long  
    Make As String
    Seats as Long
End Type

Now in a sub you can say:

ReDim CarsArray(20) as CarDef

Collections and class objects are almost the same thing. Here is the same thing but using Class Objects and Collections:

In a class module:

---------clsCar.cls

Option Explicit

Public IS as Long
Public Make as String
Public Model as String
Public Seats as Long


Now in a sub you can say:

Dim Cars as New Collection

Dim Car as clsCar ' Car becomes like one element in an array
(Which is the same as Dim CarsArray as CarCarDef ' User defined type way)


First give the car its data:

AnyCount = AnyCount + 1
Car.ID = AnyCount ' A unique ID
Car.Make = "Ford"
Car.Model = "Galxy"
Car.Seats = 7

Using user defined types:

Cars(0) = Car ' place data into array

Using Collections:

Cars.Add Car, Cstr(Car.ID)

Which is the same as:

Dim Car as CarDef ' User defined type

The advantage of collections over simple UDT (User Defined Type) arrays is that you can find a car easily:

Dim Car as clsCars
Set Car = Cars("1") ' car now becomes a pointer to car 1

The good thing about a set statement is that no data has moved. A change to Car.Seats also changes the data in the holder Cars so is the same as Cars("1").Seats = x but faster.

To change car 1's seats using UDT's you would need the following code:

For C = LBound(CarsArray) to UBound(CarsArray)
   If CarsArray(c).ID = 1 Then
       CarsArray(c).Seats = x
       Exit For
   End If
Next c

Which took 6 lines of code, and using class Objects and collections, it takes just 1 line of code:

Cars("1").Seats = x

The other BIG advantage that class objects have over UDT's is that they can be past as Public Parameters.  

I hope this makes sense:~)




 
       




The problem with Class Objects is that you cannot use an array as a public varaible. So you can't say:

Public ClassSeats(3)

But you can overcome this like this:

Public ClassSeats ' this is a varaint

So when you create a new object

Dim Flight as clsFlight
Set Flight = New clsFlight
Flight.Number = xxxx ' a unique ID

' Now make ClassSeats into an array
Dim Seats
Set Seats = Flight.ClassSeats
Seats= Array(0) ' Turn ClassSeats into a variant array
Redim Seats(3) ' Now the Array can be redim'ed

If you need any further help understanding please ask:~)
Author of the Year 2009

Commented:
Hi ethan211,
It appears that you have forgotten this question. I will ask Community Support to close it unless you finalize it within 7 days. I will ask a Community Support Moderator to:

    Accept inthedark's comment(s) as an answer.

ethan211, if you think your question was not answered at all or if you need help, just post a new comment here; Community Support will help you.  DO NOT accept THIS comment as an answer.

EXPERTS: If you disagree with that recommendation, please post an explanatory comment.
==========
DanRollins -- EE database cleanup volunteer

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial