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
Alloting seats for random ticket booking in ascending order
-
- 3StarLounger
- Posts: 307
- Joined: 16 Mar 2011, 09:33
Alloting seats for random ticket booking in ascending order
You do not have the required permissions to view the files attached to this post.
-
- 3StarLounger
- Posts: 307
- Joined: 16 Mar 2011, 09:33
Re: Alloting seats for random ticket booking in ascending o
Please note that there could be several bogies and several different national so I request a generic solution
-
- gamma jay
- Posts: 25455
- Joined: 17 Mar 2010, 17:33
- Location: Cape Town
Re: Alloting seats for random ticket booking in ascending o
Try this updated code in the attached workbook...
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.........
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.
Rudi
If your absence does not affect them, your presence didn't matter.
-
- 3StarLounger
- Posts: 307
- Joined: 16 Mar 2011, 09:33
Re: Alloting seats for random ticket booking in ascending o
Yes, that is correct. I to checked it with eagerness. Thank you
-
- 3StarLounger
- Posts: 307
- Joined: 16 Mar 2011, 09:33
Re: Alloting seats for random ticket booking in ascending o
Andi Rudi, I also notice that the first four Germans (green letters) do not have a seat. Thanks,
-
- gamma jay
- Posts: 25455
- Joined: 17 Mar 2010, 17:33
- Location: Cape Town
Re: Alloting seats for random ticket booking in ascending o
Replace current code with this code...
Please run and check accuracy.
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.
Rudi
If your absence does not affect them, your presence didn't matter.
-
- 3StarLounger
- Posts: 307
- Joined: 16 Mar 2011, 09:33
Re: Alloting seats for random ticket booking in ascending o
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
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
-
- gamma jay
- Posts: 25455
- Joined: 17 Mar 2010, 17:33
- Location: Cape Town
Re: Alloting seats for random ticket booking in ascending o
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.
Rudi
If your absence does not affect them, your presence didn't matter.