Converting Reservations Data into Summary

[bigck2]

Hello,

I have been wrapping my head around this problem for sometime, and I know that someone can help me figure this out!

I have a large amount of reservations data for a hotel. The data table looks like this:

Arrival Date	Departure Date	Rate Code	Average LOS	Room Nights	Room Revenue (USD)	ADR (USD)
Jan 1, 2014	Jan 3, 2014	TL	2.0	2	$200	$99.85
Jan 1, 2014	Jan 2, 2014	AD	1.0	1	$112	$111.59
Jan 1, 2014	Jan 2, 2014	T1	1.0	1	$139	$139.00
Jan 1, 2014	Jan 2, 2014	LV8	1.0	1	$149	$149.00
Jan 2, 2014	Jan 3, 2014	2G	1.0	2	$258	$129.00
Jan 2, 2014	Jan 3, 2014	CMP	1.0	1	$1	$1.00
Jan 2, 2014	Jan 4, 2014	I7	2.0	2	$198	$99.00
Jan 3, 2014	Jan 5, 2014	LV8	2.0	2	$278	$139.00
Jan 3, 2014	Jan 4, 2014	LV8	1.0	2	$278	$139.00

<colgroup><col><col><col><col span="2"><col><col></colgroup><tbody>
</tbody>

Each row represents a reservation at a hotel. What I'm trying to do is convert this information from arrival date and departure date to represent stay date and then attribute the revenue appropriately. (LOS stands for 'Length of Stay').

The final product I'm trying to create is a report that shows the total number of rooms, average rate (ADR), and revenue for each rate code on a particular stay date.

I've been able to come up with some solutions that work, but they are extremely slow. My data table can be from 10,000 to 50,000 records and my solutions take several minutes to complete.

Please let me know if any one has any thoughts?

Thanks,

Chris

 

[bobkuhn]

You have solutions but they're too slow.

I've used the following methods to speed up execution of my macros:
1) Turn off display updating via "Application.ScreenUpdating = False"
2) Use arrays

Below is an array example. When converting to the array method you need to be careful with the indices. The spreadsheet rows/columns start with 1 while the array indices start with 0.

Bob

Sub report_reformat_array()
 
Dim source_array As Variant
Dim destination_array As Variant
Dim temp As Variant
 
     source_array = Range(Cells(1, 1), ActiveCell.SpecialCells(xlLastCell)).Value  ' read in source sheet
    
     max_x = UBound(source_array, 1) - LBound(source_array, 1) + 1
     ReDim destination_array(max_x, 12)   ' make destination array the same size - that way we know for sure that it's big enough
    
    
     source_row = 2
     destination_row = 0 'array index starts at 0
    
     current_invoice_num = source_array(2, 1)
    
     Do While current_invoice_num <> ""
       destination_array(destination_row, 0) = current_invoice_num
       destination_array(destination_row, 1) = source_array(source_row, 5)  'copy amount over
       destination_array(destination_row, 11) = source_array(source_row, 5)  ' the two amounts are alwats the same
       PRD_num = 1
     
' copy PRD data over
       Do While current_invoice_num = source_array(source_row, 1)  ' only move PRD data if in same invoice
         destination_array(destination_row, 3 * PRD_num - 1) = source_array(source_row, 2)
         destination_array(destination_row, 3 * PRD_num) = source_array(source_row, 3)
         destination_array(destination_row, 3 * PRD_num + 1) = source_array(source_row, 4)
         PRD_num = PRD_num + 1
         source_row = source_row + 1
       Loop
 
' done with this invoice
       destination_row = destination_row + 1
       current_invoice_num = source_array(source_row, 1)
     Loop
 
     Sheets.Add
    
' init header row
     Cells(1, 1) = "Invoice"
     Cells(1, 2) = "Amount"
     Cells(1, 3) = "PRD1"
     Cells(1, 4) = "Com1"
     Cells(1, 5) = "PRD 1 %"
     Cells(1, 6) = "PRD2"
     Cells(1, 7) = "Com2"
     Cells(1, 8) = "PRD 2 %"
     Cells(1, 9) = "PRD3"
     Cells(1, 10) = "Com3"
     Cells(1, 11) = "PRD 3 %"
     Cells(1, 12) = "Total Amount"
 
' make pretty
     Columns("L:L").ColumnWidth = 12.43
     Range("D:D,B:B,G:G,J:J,L:L").Select
     Selection.NumberFormat = "#,##0.00"
 
 
     Range(Cells(2, 1), Cells(destination_row + 1, 12)).Value = destination_array 'paste array into spreadsheet
     
     Cells(1, 1).Select
 
End Sub

 

[bigck2]

Hi Bob,

Thanks for your suggestions and sample code.

I tried to learn enough about Arrays to make my macro work, but ultimately I couldn't figure it out. Do you have some sample data that you could share you would have used that code for? Maybe with that I could better learn the arrays techniques to apply to my data set.

I did find a solution that isn't terribly slow as some of my earlier methods.

I ended up using some nested loops and adding additional rows for each record where the departure date was more than 1 day after the arrival date.

Here is the code I used:

Sub Practice()


    Dim LR1 As Long
    Dim LR2 As Long
    Dim LC As Long
    Dim NoDays As Long
    Dim i As Long
    Dim y As Long
    
    Application.ScreenUpdating = False
    
        
    LR1 = Cells(Rows.Count, 1).End(xlUp).Row
    LC = Cells(1, Columns.Count).End(xlToLeft).Column
    
    For i = 2 To LR1
        If (Cells(i, 7).Value - Cells(i, 5).Value) > 1 Then
            
            NoDays = Cells(i, 7).Value - Cells(i, 5).Value
            
            counter = counter + 1
            
            LR2 = Cells(Rows.Count, 1).End(xlUp).Row
            
            For y = 2 To NoDays
            
                Range(Cells(LR2 + (y - 1), 1), Cells(LR2 + (y - 1), LC)).Value = Range(Cells(i, 1), Cells(i, LC)).Value
                Cells(LR2 + (y - 1), LC + 1).Value = Cells(i, 5).Value + (y - 1)
            
            Next y
        
        End If
        
        Cells(i, LC + 1).Value = Cells(i, 5).Value
    Next i
    


End Sub

Still a little bit slower than I would like, but it works!

Thanks again for your help!

-Chris