title: VBA Code to select a range of dates for Reservation spreadsheet
body: <p>I'm new to VBA and I'm trying to adapt what I've found online to meet my needs.  I'm trying to set up a Reservation system.  As I currently have it set up I enter the following information on sheet1 (reservation).  I'm using a different macro to store all of that info on sheet2 (data).<br>
      Name:<br>
      Site #<br>
      Start Date: 1/3/2015<br>
      End Date:   1/7/2015<br>
      Pets:   No<br>
      Club:<br>
      Phone #:<br>
      Status:     </p>
  
  <p>What I would like to be able to do is to populate a "calendar" of what site is being used on what date. I would like the customer's name to show up in the correct site row on their "start date".  I would like their range of dates with me to  be highlighted in the correct color code of their "status".               </p>
  
  <p>The code that I'm trying to modify only selected the start date and it puts their "status" in that box.  I've included the code below.  Any help would be greatly appreciated. 
  thanks,
  Henry</p>
  
  <p>Sub Bookings()</p>
  
  <pre><code>Dim Rm As Range, Dt As Range, Myrng As Range, Sites As Range
  Dim endCol As Range, StCol As Range, StRow As Range, endRow As Range
  Dim Codei As Range, Col As Range
  Dim Dws As Worksheet, Cws As Worksheet
  Dim x As Integer
  Dim LastRow As Long
  Dim aCell As Range, bCell As Range, dCell As Range
  
  Set Cws = Reservation
  Set Dws = Data
  Set StCol = Cws.Range("AL3")
  Set endCol = Cws.Range("AN3")
  Set StRow = Cws.Range("AP3")
  Set endRow = Cws.Range("AR3")
  
  LastRow = Dws.Range("C" &amp; Rows.Count).End(xlUp).Row
  Set Myrng = Dws.Range("B2:B" &amp; LastRow)   'data sheet columns
  Cws.Range("C15:AD83").ClearContents
  Cws.Range("C15:AD83").Interior.ColorIndex = xlNone
      For x = StRow To endRow
      Set Sites = Cws.Cells(x, 2)
              For Each d Cell In Cws.Range(Cells(x, StCol), Cells(x, endCol))
          If Not dCell Is Nothing Then
              Set Dt = Cells(11, dCell.Column)
                              Set aCell = Myrng.Find(What:=Sites, LookIn:=xlValues, _
                                     LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                     MatchCase:=False, SearchFormat:=False)
              If Not aCell Is Nothing Then
                  Set bCell = aCell
                                      Do
                      Set aCell = Myrng.FindNext(After:=aCell)
                      If aCell.Offset(0, 1).Value = Dt.Value Then
                          Set Codei = aCell.Cells(1, 4)
                          Set Col = aCell.Cells(1, 3)
                          dCell.Value = Codei
                          Select Case Col
                              Case Cws.Range("AJ3").Value
                                  dCell.Interior.ColorIndex = 27
                              Case Cws.Range("AJ4").Value
                                  dCell.Interior.ColorIndex = 24
                              Case Cws.Range("AJ5").Value
                                  dCell.Interior.ColorIndex = 4
                              Case Cws.Range("AJ6").Value
                                  dCell.Interior.ColorIndex = 38
                          End Select
                      End If
                      If Not aCell Is Nothing Then
                          If aCell.Address = bCell.Address Then Exit Do
                      Else
                          Exit Do
                      End If
                  Loop
  
              End If
          End If
      Next dCell
  
  Next
  
  On Error GoTo 0
  </code></pre>
  
  <p>End Sub</p>