Alloting seats for random ticket booking in ascending order

vilas desai
3StarLounger
Posts: 307
Joined: 16 Mar 2011, 09:33

Alloting seats for random ticket booking in ascending order

Post by vilas desai »

Dear Sirs

(I had earlier asked a similar question under the heading "filling in Missing numbers" and had excellent solutions from Hans and Rudi. But I realized that my question is a bit more complex than it sounded initially. I am therefore creating a "scenario" of my problem along with an example which I can use in my Real Time application.

Please see the attached file.
Problem Statement
A trains with 4 bogies carries citizens from 4 countries Bogie 1JBA1 will carry Americans (Blue letters) Bogie 1JBB1 will carry Germans (Green letters)
Bogie 1JBB2 will carry Spaniards (Black letters) Bogie 2JBB1 will carry Dutch (Orange letters)
All bogies are arranged in ascending order.
A ticketing counter accepts group booking as in col B Seats are allotted at the counter as in Col D The seat allotment will always start from Seat No 1
but the subsequent seats can be randomly selected by the traveler. For ex, the first German (row 3, name Abc) will be allotted seat No 1 only but subsequent germans
(ex row 8, name bca) can choose seats of their choice. However seats for any group will be consecutive.

Consider the following examples
Row 3: A german 'Abc' makes a group booking for 4. The seats alloted to him in Bogie IJBB1 are from 1 to 4 (no choice of seats) Row 4: An American 'acb' makes a group booking for 2, and gets seat nos 1 and 2 without choice.
row 5: Another American 'bac' makes a group booking of 2 and gets 2 seats of his choice starting from seat No 7.

The output is a "Reservation Chart" as shown in RED bar, cols K:N
When I press a button "Copy and Fix" in the worksheet MasterLIst,
I should be getting the output (Reservation Cart) in sheet JB_Term starting from
Col A, Row 4, I will write the headers in all worksheets by myself in Row 3

(Also please remember that when the button is clicked, it will first clear all contents in the wsh JB_Term STARTING from row no 4)


Thanking you in advance and with best regards
Vilas Desai
You do not have the required permissions to view the files attached to this post.

vilas desai
3StarLounger
Posts: 307
Joined: 16 Mar 2011, 09:33

Re: Alloting seats for random ticket booking in ascending o

Post by vilas desai »

Please note that there could be several bogies and several different national so I request a generic solution

User avatar
Rudi
gamma jay
Posts: 25455
Joined: 17 Mar 2010, 17:33
Location: Cape Town

Re: Alloting seats for random ticket booking in ascending o

Post by Rudi »

Try this updated code in the attached workbook...
fill_missing_nos New.xlsm
EDIT:
Sorry...on further checking I see the last citizen in each group is not being processed with the amount of tickets/seats ordered.
Needs more fixing.........
You do not have the required permissions to view the files attached to this post.
Regards,
Rudi

If your absence does not affect them, your presence didn't matter.

vilas desai
3StarLounger
Posts: 307
Joined: 16 Mar 2011, 09:33

Re: Alloting seats for random ticket booking in ascending o

Post by vilas desai »

Yes, that is correct. I to checked it with eagerness. Thank you

vilas desai
3StarLounger
Posts: 307
Joined: 16 Mar 2011, 09:33

Re: Alloting seats for random ticket booking in ascending o

Post by vilas desai »

Andi Rudi, I also notice that the first four Germans (green letters) do not have a seat. Thanks,

User avatar
Rudi
gamma jay
Posts: 25455
Joined: 17 Mar 2010, 17:33
Location: Cape Town

Re: Alloting seats for random ticket booking in ascending o

Post by Rudi »

Replace current code with this code...
Please run and check accuracy.

Code: Select all

Sub SortAndInsert()
    Const lngFirstRow = 3 ' Start row of data
    Const lngSourceCol = 1 ' First column of data (H)
    Const lngTargetCol = 1 ' First column of sorted data (A)
    Dim wshSource As Worksheet
    Dim wshTarget As Worksheet
    Dim rTarget As Range
    Dim lngLastRow As Long
    Dim lngRow As Long
    Dim i As Integer
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Set wshSource = Worksheets("JB_Sch")
    Set wshTarget = Worksheets("JB_Term")
    Set rTarget = wshTarget.Range(wshTarget.Cells(4, lngTargetCol), wshTarget.Cells(wshTarget.Columns(lngTargetCol).Cells.Count, lngTargetCol + 3))
    rTarget.Clear
    lngLastRow = wshSource.Cells(wshSource.Rows.Count, lngSourceCol).End(xlUp).Row + 1
    wshSource.Range(wshSource.Cells(lngFirstRow, lngSourceCol), _
        wshSource.Cells(lngLastRow, lngSourceCol + 3)).Copy _
        Destination:=wshTarget.Cells(lngFirstRow, lngTargetCol)
    wshTarget.Range(wshTarget.Cells(lngFirstRow, lngTargetCol), _
        wshTarget.Cells(lngLastRow, lngTargetCol + 3)).Sort _
        Key1:=wshTarget.Cells(lngFirstRow, lngTargetCol + 2), _
        Key2:=wshTarget.Cells(lngFirstRow, lngTargetCol + 3)
    For lngRow = lngLastRow To lngFirstRow Step -1
        If wshTarget.Cells(lngRow, lngTargetCol + 2).Value <> _
                wshTarget.Cells(lngRow - 1, lngTargetCol + 2).Value Then
            For i = wshTarget.Cells(lngRow - 1, lngTargetCol + 1).Value -1 To 1 Step -1
                wshTarget.Cells(lngRow, lngTargetCol).EntireRow.Insert
                    wshTarget.Cells(lngRow, lngTargetCol + 2).Value = _
                        wshTarget.Cells(lngRow - 1, lngTargetCol + 2).Value
                    wshTarget.Cells(lngRow, lngTargetCol + 3).Value = _
                        wshTarget.Cells(lngRow - 1, lngTargetCol + 3).Value + i
            Next i
        Else
            Do While wshTarget.Cells(lngRow, lngTargetCol + 2).Value = _
                    wshTarget.Cells(lngRow - 1, lngTargetCol + 2).Value And _
                    wshTarget.Cells(lngRow, lngTargetCol + 3).Value > _
                    wshTarget.Cells(lngRow - 1, lngTargetCol + 3).Value + 1
                wshTarget.Cells(lngRow, lngTargetCol).EntireRow.Insert
                wshTarget.Cells(lngRow, lngTargetCol + 2).Value = _
                    wshTarget.Cells(lngRow - 1, lngTargetCol + 2).Value
                wshTarget.Cells(lngRow, lngTargetCol + 3).Value = _
                    wshTarget.Cells(lngRow + 1, lngTargetCol + 3).Value - 1
            Loop
        End If
    Next lngRow
ExitHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub
Regards,
Rudi

If your absence does not affect them, your presence didn't matter.

vilas desai
3StarLounger
Posts: 307
Joined: 16 Mar 2011, 09:33

Re: Alloting seats for random ticket booking in ascending o

Post by vilas desai »

Dear Rudi,
Thuis code works perfect, except that col K (assuming Col H is the starting col) in JB_Sch worksheet is based on formulas and so when copied in worksheet JB_term in Col D, the formula does not get evaluated due to incorrect referencing. So the copy should be based on Values. Request on the same please.
Best regards
Vilas Desai

User avatar
Rudi
gamma jay
Posts: 25455
Joined: 17 Mar 2010, 17:33
Location: Cape Town

Re: Alloting seats for random ticket booking in ascending o

Post by Rudi »

This will paste as values...

Code: Select all

Sub SortAndInsert()
    Const lngFirstRow = 3 ' Start row of data
    Const lngSourceCol = 1 ' First column of data (H)
    Const lngTargetCol = 1 ' First column of sorted data (A)
    Dim wshSource As Worksheet
    Dim wshTarget As Worksheet
    Dim rTarget As Range
    Dim lngLastRow As Long
    Dim lngRow As Long
    Dim i As Integer
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Set wshSource = Worksheets("JB_Sch")
    Set wshTarget = Worksheets("JB_Term")
    Set rTarget = wshTarget.Range(wshTarget.Cells(4, lngTargetCol), wshTarget.Cells(wshTarget.Columns(lngTargetCol).Cells.Count, lngTargetCol + 3))
    rTarget.Clear
    lngLastRow = wshSource.Cells(wshSource.Rows.Count, lngSourceCol).End(xlUp).Row + 1
    wshSource.Range(wshSource.Cells(lngFirstRow, lngSourceCol), _
        wshSource.Cells(lngLastRow, lngSourceCol + 3)).Copy
        wshTarget.Cells(lngFirstRow, lngTargetCol).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
        wshTarget.Cells(lngFirstRow, lngTargetCol).PasteSpecial Paste:=xlPasteValues
    wshTarget.Range(wshTarget.Cells(lngFirstRow, lngTargetCol), _
        wshTarget.Cells(lngLastRow, lngTargetCol + 3)).Sort _
        Key1:=wshTarget.Cells(lngFirstRow, lngTargetCol + 2), _
        Key2:=wshTarget.Cells(lngFirstRow, lngTargetCol + 3)
    For lngRow = lngLastRow To lngFirstRow Step -1
        If wshTarget.Cells(lngRow, lngTargetCol + 2).Value <> _
                wshTarget.Cells(lngRow - 1, lngTargetCol + 2).Value Then
            For i = wshTarget.Cells(lngRow - 1, lngTargetCol + 1).Value - 1 To 1 Step -1
                wshTarget.Cells(lngRow, lngTargetCol).EntireRow.Insert
                    wshTarget.Cells(lngRow, lngTargetCol + 2).Value = _
                        wshTarget.Cells(lngRow - 1, lngTargetCol + 2).Value
                    wshTarget.Cells(lngRow, lngTargetCol + 3).Value = _
                        wshTarget.Cells(lngRow - 1, lngTargetCol + 3).Value + i
            Next i
        Else
            Do While wshTarget.Cells(lngRow, lngTargetCol + 2).Value = _
                    wshTarget.Cells(lngRow - 1, lngTargetCol + 2).Value And _
                    wshTarget.Cells(lngRow, lngTargetCol + 3).Value > _
                    wshTarget.Cells(lngRow - 1, lngTargetCol + 3).Value + 1
                wshTarget.Cells(lngRow, lngTargetCol).EntireRow.Insert
                wshTarget.Cells(lngRow, lngTargetCol + 2).Value = _
                    wshTarget.Cells(lngRow - 1, lngTargetCol + 2).Value
                wshTarget.Cells(lngRow, lngTargetCol + 3).Value = _
                    wshTarget.Cells(lngRow + 1, lngTargetCol + 3).Value - 1
            Loop
        End If
    Next lngRow
ExitHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub
Regards,
Rudi

If your absence does not affect them, your presence didn't matter.