Checking in and out for booking system with VBA Code

[oblix]

I have a booking system that populates the names of guests in the form of a gantt style reservation chart.
Each date has two columns for same date. Currently if i book a person with arrival and departure date, it populates both columns.
I would like for the arrival to populate the second column of date, and the departure date to populate only the first column.
The idea is that a person can depart and another person booked on the same date in the same room.

Code for adding, edit lookup and delete for bookings are:

Sub AddMe()
    'declare the variables
    Dim Bws As Worksheet
    Dim Fws As Worksheet
    Dim Dt As Range
    Dim Rm As Range
    Dim ID As Range
    Dim CK As Range
    Dim orange As Range
    Dim LastRow As Long
    Dim nextrow As Range
    'turn off screen updating
    Application.ScreenUpdating = False
    'variables
    Set Bws = Sheet2
    Set Fws = Sheet4
    Set Dt = Bws.Range("V4")
    Set Rm = Bws.Range("V3")
    Set ID = Fws.Range("B5")
    Set CK = Fws.Range("BM6")

    On Error GoTo errHandler:
    'check for sufficent data
    If Bws.Range("V4").Value = "" Or Bws.Range("V3").Value = "" Or Bws.Range("An3").Value = "" Then
        MsgBox "There is insufficient data to add"
        Exit Sub
    End If
    'run the filter to check for duplicates
    AdvChk
    'if duplicate exist then stop and inform user
    If CK.Value > 0 Then
        MsgBox "This name or date already exists .This is a duplicate"
        Exit Sub
    End If
    'find the next free row
    Set nextrow = Fws.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
    With nextrow
        .Offset(0, -1).Value = ID.Value + 1
        .Value = Bws.Range("V3").Value
        .Offset(0, 1).Value = Bws.Range("V4").Value
        .Offset(0, 2).Value = Bws.Range("V5").Value
        .Offset(0, 3).Value = Bws.Range("V6").Value
        .Offset(0, 4).Value = Bws.Range("V7").Value
        .Offset(0, 5).Value = Bws.Range("AE3").Value
        .Offset(0, 6).Value = Bws.Range("AE4").Value
        .Offset(0, 7).Value = Bws.Range("AE5").Value
        .Offset(0, 8).Value = Bws.Range("AE7").Value
        .Offset(0, 9).Value = Bws.Range("AN3").Value
        .Offset(0, 10).Value = Bws.Range("AN4").Value
        .Offset(0, 11).Value = Bws.Range("AN5").Value
        .Offset(0, 12).Value = Bws.Range("AN6").Value
        .Offset(0, 13).Value = Bws.Range("AN7").Value
        .Offset(0, 14).Value = Bws.Range("AZ3").Value
        .Offset(0, 15).Value = Bws.Range("BD3").Value
        .Offset(0, 16).Value = Bws.Range("AZ4").Value
        .Offset(0, 17).Value = Bws.Range("BD4").Value
        .Offset(0, 18).Value = Bws.Range("AZ5").Value
        .Offset(0, 19).Value = Bws.Range("BD5").Value
        .Offset(0, 20).Value = Bws.Range("AZ6").Value
        .Offset(0, 21).Value = Bws.Range("BD6").Value
        .Offset(0, 22).Value = Bws.Range("AZ7").Value
        .Offset(0, 23).Value = Bws.Range("BD7").Value
    End With
    'run the filter to limit data
    FilterRng
    'select the bookings sheet
    Bws.Select
    'run the macro to add the bookings
    Bookings
    'clear the values
    Clearme
    'error block
    On Error GoTo 0
    Exit Sub
errHandler:
    MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
    & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "Please notify the administrator"
End Sub
Sub Bookings()
    'declare the variables
    Dim bCell As Range, Rm As Range, Dt As Range, orange As Range
    Dim dCell As Range, aCell As Range, Cl As Range, Nn As Range, ID As Range
    Dim Fws As Worksheet, Bws As Worksheet
    Dim x As Integer
    Dim LastRow As Long
    Dim oCell As Variant
    Dim iCell As Variant

    On Error Resume Next

    'variables
    Set Fws = Sheet4 'data sheet
    Set Bws = Sheet2 'bookings sheet

    'filter the data to limit
    FilterRng
    'set the range to loop through
    LastRow = Fws.Range("AJ" & Rows.Count).End(xlUp).Row
    Set orange = Fws.Range("AJ9:AJ" & LastRow)
    'clear the values from the calendar
    Bws.Range("E13:BH40").ClearContents
    Bws.Range("E13:BH40").Interior.ColorIndex = xlNone

    'LOOP 1"""""""""""""""""""""""""""""""
    'set the variable for the number of rows and loop through
    For x = 13 To 40
        'set the room variable
        Set Rm = Bws.Cells(x, 3)

        'LOOP 2"""""""""""""""""""""""""""""'
        'loop through column range
        For Each dCell In Bws.Range(Cells(x, 5), Cells(x, 60))
            If Not dCell Is Nothing Then
                'set the date variable
                Set Dt = Cells(12, dCell.Column)

                'FIND FUNCTION""""""""""""""""""""
                'find the rooms
                Set aCell = orange.Find(What:=Rm, LookIn:=xlValues, _
                    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)
                If Not aCell Is Nothing Then
                    'set the room variable
                    Set bCell = aCell

                    'LOOP 3"""""""""""""""""""""""
                    'loop through the filtered data
                    Do
                        'find the next room with a booking
                        Set aCell = orange.FindNext(After:=aCell)
                        'establish the dates to add
                        If aCell.Offset(0, 1).Value <= Dt.Value And aCell.Offset(0, 3).Value >= Dt.Value Then
                            'set the variables
                            Set Cl = aCell.Cells(1, 5) 'status
                            Set Nn = aCell.Cells(1, 10) 'name
                            Set ID = aCell.Offset(0, -1) 'ID
                            'add the names and reassign after once
                            If oCell <> Nn Or iCell <> ID Then
                                dCell.Value = Nn
                                Set oCell = Nn
                                Set iCell = ID
                            End If
                            'add the coloring
                            Select Case Cl
                                Case "Unconfirmed"
                                    dCell.Interior.ColorIndex = 27
                                Case "Confirmed"
                                    dCell.Interior.ColorIndex = 24
                                Case "Paid"
                                    dCell.Interior.ColorIndex = 4
                                Case "Cancelled"
                                    dCell.Interior.ColorIndex = 38
                            End Select
                        End If
                        'exit when values are found
                        If Not aCell Is Nothing Then
                            If aCell.Address = bCell.Address Then Exit Do
                        Else
                            Exit Do
                        End If
                        '
                    Loop 'LOOP 3 end
                    '
                End If
            End If
            '
            Next dCell 'LOOP 2 end
    '
    Next x 'LOOP 1 end
    '
    On Error GoTo 0
End Sub
Sub LookUp()
    'declare the variable
    Dim Dt As Range, Nn As Range, Rm As Range
    Dim c As Range, orange As Range
    Dim LastRow As Long
    'set object variables
    Set Nn = ActiveCell
    Set Dt = Cells(12, Nn.Column)
    Set Rm = Cells(Nn.Row, 3)
    'set the variable range to loop through
    LastRow = Sheet4.Range("D" & Rows.Count).End(xlUp).Row
    Set orange = Sheet4.Range("D9:D" & LastRow)
    'error handler
    On Error GoTo errHandler:
    'establish data is there and loop
    If Not Range("E13:BH40") Is Nothing Then
        For Each c In orange 'add dynamic range
            '1. has a value 2.Verify Room 3.Look in date range 4. Check the name [optional]
            If c.Value <> 0 And c.Offset(0, -1) = Rm.Value And c.Value <= Dt.Value And c.Offset(0, 2).Value >= Dt.Value Then 'And c.Offset(0, 8).Value = Nn
                'add the values selectively to the top of the calendar
                With Sheet2
                    .Range("H3").Value = c.Cells(1, -1).Value
                    .Range("V3").Value = c.Cells(1, 0).Value
                    .Range("V4").Value = c.Value
                    '.Range("V5").Value = c.Cells(1, 2).Value 'days calculated do not send
                    .Range("V6").Value = c.Cells(1, 3).Value
                    .Range("V7").Value = c.Cells(1, 4).Value
                    .Range("AE3").Value = c.Cells(1, 5).Value
                    .Range("AE4").Value = c.Cells(1, 6).Value
                    .Range("AE5").Value = c.Cells(1, 7).Value
                    '.Range("AE6").Value 'calculated value not available in data
                    '.Range("AE7").Value = c.Cells(1, 8).Value 'total calculated do not send
                    .Range("AN3").Value = c.Cells(1, 9).Value
                    .Range("AN4").Value = c.Cells(1, 10).Value
                    .Range("AN5").Value = c.Cells(1, 11).Value
                    .Range("AN6").Value = c.Cells(1, 12).Value
                    .Range("AN7").Value = c.Cells(1, 13).Value
                    .Range("AZ3").Value = c.Cells(1, 14).Value
                    .Range("BD3").Value = c.Cells(1, 15).Value
                    .Range("AZ4").Value = c.Cells(1, 16).Value
                    .Range("BD4").Value = c.Cells(1, 17).Value
                    .Range("AZ5").Value = c.Cells(1, 18).Value
                    .Range("BD5").Value = c.Cells(1, 19).Value
                    .Range("AZ6").Value = c.Cells(1, 20).Value
                    .Range("BD6").Value = c.Cells(1, 21).Value
                    .Range("AZ7").Value = c.Cells(1, 22).Value
                    .Range("BD7").Value = c.Cells(1, 23).Value

                End With
            End If
        Next c
    End If
    'error block
    On Error GoTo 0
    Exit Sub
errHandler::
    MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
    & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "Please notify the administrator"
End Sub

Sub DeleteMe()
    'declare the variables
    Dim ID As Range, c As Range, orange As Range
    Dim LastRow As Long
    'set the object variable
    Set ID = Sheet2.Range("H3")
    'stop screen flicker
    Application.ScreenUpdating = False
    LastRow = Sheet4.Range("B" & Rows.Count).End(xlUp).Row
    Set orange = Sheet4.Range("B9:B" & LastRow)
    'find the value in the range
    For Each c In orange
        If c.Value = ID.Value Then
            'delete the row
            c.EntireRow.Delete
            'sort the data
            Sortit
        End If
    Next c
    'et go home
    Sheet2.Select
    'update the calendar

    Bookings
End Sub
Sub EditMe()
  'declare the variables
  Dim Bws As Worksheet, Fws As Worksheet, f As Range, wID As Variant
  'turn off screen updating
  Application.ScreenUpdating = False
  'variables
  Set Bws = Sheet2
  Set Fws = Sheet4
  'check for sufficent data
  If Bws.Range("H3").Value = "" Or Bws.Range("V3").Value = "" Or _
     Bws.Range("V4").Value = "" Or Bws.Range("AN3").Value = "" Then
      MsgBox "There is insufficient data to Edit"
      Exit Sub
  End If
  'find ID
  wID = Bws.Range("H3").Value
  Set f = Fws.Range("B9:B" & Fws.Range("B" & Rows.Count).End(xlUp).Row).Find(wID, , xlValues, xlWhole)
  If f Is Nothing Then
    MsgBox "ID does not exists"
    Exit Sub
  End If
  With f
    .Offset(0, 1).Value = Bws.Range("V3").Value
    .Offset(0, 2).Value = Bws.Range("V4").Value
    .Offset(0, 3).Value = Bws.Range("V5").Value
    .Offset(0, 4).Value = Bws.Range("V6").Value
    .Offset(0, 5).Value = Bws.Range("V7").Value
    .Offset(0, 6).Value = Bws.Range("AE3").Value
    .Offset(0, 7).Value = Bws.Range("AE4").Value
    .Offset(0, 8).Value = Bws.Range("AE5").Value
    .Offset(0, 9).Value = Bws.Range("AE7").Value
    .Offset(0, 10).Value = Bws.Range("AN3").Value
    .Offset(0, 11).Value = Bws.Range("AN4").Value
    .Offset(0, 12).Value = Bws.Range("AN5").Value
    .Offset(0, 13).Value = Bws.Range("AN6").Value
    .Offset(0, 14).Value = Bws.Range("AN7").Value
    .Offset(0, 15).Value = Bws.Range("AZ3").Value
    .Offset(0, 16).Value = Bws.Range("BD3").Value
    .Offset(0, 17).Value = Bws.Range("AZ4").Value
    .Offset(0, 18).Value = Bws.Range("BD4").Value
    .Offset(0, 19).Value = Bws.Range("AZ5").Value
    .Offset(0, 20).Value = Bws.Range("BD5").Value
    .Offset(0, 21).Value = Bws.Range("AZ6").Value
    .Offset(0, 22).Value = Bws.Range("BD6").Value
    .Offset(0, 23).Value = Bws.Range("AZ7").Value
    .Offset(0, 24).Value = Bws.Range("BD7").Value
  End With
  FilterRng   'run the filter to limit data
  Bws.Select  'select the bookings sheet
  Bookings    'run the macro to add the bookings
  Clearme     'clear the values
End Sub

 

[oblix]

I have discovered another problem.......
If I lookup a booking and move the dates or the room of that booking and it overlaps on another existing booking it does not check and allows it to happen.
im sure it is supposed to do a filter again before allowing to change.
PLS Help

 

[oblix]

bump

 

[oblix]

Bump