Help for VBA OPTIMIZATION ? - especially, but not only, in regards to SPEED

[Gabriel222]

Hello, MrExcel Team!

I've written the below VBA, which works.
However I would like to optimize to the MAXIMUM !!

Any suggestions are more than welcome, especially those regarding SPEED !!

The idea behind the code is :

I have a Database "source" table, that has 1 row per reservation.
I would like to transform it to a table that has 1 row per reservation AND per roomnight (so for each roomnight I will have a repeating row for each reservation)

Here is my code so far :

Sub Resv_to_Nights()

Dim dbsheet As Worksheet 'Database source sheet
Dim tgsheet As Worksheet 'Target sheet
Dim x As Integer 'Counter for main loop, each row in source sheet
Dim y As Integer 'Counter for sub-loop, each room night for each reservation
Dim room_n As Integer 'Number of roomnights
Dim ci As Double 'Check-In date
Dim co As Double 'Check-Out date
Dim lastrow As Double 'Last row of table
Dim lastcol As Double 'Last column of table
Dim pctcompl As Integer 'Percentage of completion
Dim delrng As Object 'Range to be deleted
Dim startcell As Range 'Starting cell below headers


    'Set sheet names and last row of source table


Set dbsheet = ThisWorkbook.Sheets("GHO_Source_1")
Set tgsheet = ThisWorkbook.Sheets("GHO_Source_2")
Set startcell = Range("A2")


lastrow = tgsheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcol = tgsheet.Cells(1, Columns.Count).End(xlToLeft).Column


    'Check if target table has previous data
    
If lastrow = 1 And IsEmpty(Cells(1, 1)) = False Then
    GoTo main
  Else
    GoTo delete_previous:
End If


delete_previous:


    Set delrng = tgsheet.Range(startcell, tgsheet.Cells(lastrow, lastcol))
    
        'Delete existing values in target table
        
    delrng.EntireRow.Delete


main:


    lastrow = dbsheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    
        'Begin loop through source table
    
    Application.ScreenUpdating = False
    
    For x = 2 To lastrow - 1
    
        'dbsheet.Select
        'Cells(x, 1).Select
        
        
            'Find check-in and check-out dates and calculate lengths of stay
        
        ci = CDbl(DateValue(dbsheet.Cells(x, 6).Value))
        co = CDbl(DateValue(dbsheet.Cells(x, 7).Value))
        
        
            'Account for "Day-Use" scenarios
            
        If co - ci = 0 Then
                room_n = 1
            Else
                room_n = co - ci
        End If
        
        
            'Copy & Paste to target table
        
        dbsheet.Cells(x, 1).EntireRow.Copy
        tgsheet.Cells(2, 1).EntireRow.Insert Shift:=xlDown
         
         
                'Repeat for each room night, or just once for a day-use
         
            For y = 1 To room_n - 1
            
                tgsheet.Cells(2, 1).EntireRow.Copy
                tgsheet.Cells(2, 1).EntireRow.Insert Shift:=xlDown
                
            Next y
            
            
    Next x
    
    Application.CutCopyMode = False
    
    Application.ScreenUpdating = True


End Sub

Thank you for your input !

 

[NotoriousPopol]

The idea to do this kind og stuff faster is :

- read your database and put the data in an Array (in this case a matrix). You will put 3 times the data if you have 3 nights.
- read the Array and put the data in your 2nd sheet.

I tried this once for a 5 000+ row file, it was really faster this way!