Generate a list depending on date entered

Private Sub Worksheet_Change(ByVal Target As Range) 

   If (Target.Address <> "$C$2") Then Exit Sub 
   If Target.Value = vbNullString Then Exit Sub 
    
   If IsDate(Target) Then 
      Application.EnableEvents = False 
      Call doLocateMovement(Target.Value) 
      Application.EnableEvents = True 
       
   Else 
      MsgBox "Please enter a valid date.", vbCritical, "Invalid Date" 
      Application.EnableEvents = False 
      Target = vbNullString 
      Application.EnableEvents = True 
   End If 
End Sub 

Private Sub doLocateMovement(sDate As String) 

   Dim lTgtRow               As Long 
   Dim rngTarget              As Range 
   Dim sMove                  As String 
   Dim sDiary                 As String 
   Dim iCol                   As Integer 
   Dim iMaxCol                As Integer 
   Dim iJobTitleRow           As Integer 
   Dim iNameRow               As Integer 
   Dim iRotationRow           As Integer 
   Dim dicJobTitle            As Object 
   Dim sJobTitle              As String 
   Dim sName                  As String 
   Dim sRotation              As String 
   Dim sReasonCode            As String 
   Dim vOption                As Variant 
   Dim arrRecGroup            As Variant 
   Dim arrRecDetail           As Variant 
   Dim lRecGroup              As Long 
   Dim lRecDetail             As Long 
   Dim lDetailRow             As Long 
    
   iJobTitleRow = 4 
   iNameRow = 5 
   iRotationRow = 6 
    
   sMoveSheet = "Movements" 
   sDiary = "Diary" 
   With Sheets(sMoveSheet) 

       ' locate the date text on column A
      lTgtRow = getItemRowLocation(sDate, .Name, Range("A:A")) 
      If (lTgtRow < 1) _ 
      Then 
         MsgBox sDate & " not found in sheet " & .Name 
         Exit Sub 
      End If 

     ' locate last column used on the row located
      iMaxCol = getLastColumn(.Name, Range(Cells(1, "B"), Cells(Rows.Count, Columns.Count))) 
      If (iMaxCol = 0) _ 
      Then 
         MsgBox "No record found for date " & sDate, vbInformation, "Record Not Found" 
         Exit Sub 
      End If 
       
      Set dicJobTitle = CreateObject("Scripting.Dictionary") 
      For iCol = 2 To iMaxCol 
         If (.Cells(lTgtRow, iCol) <> vbNullString) _ 
         Then 
            sJobTitle = .Cells(iJobTitleRow, iCol) 
            sName = .Cells(iNameRow, iCol) 
            sRotation = .Cells(iRotationRow, iCol) 
            sReasonCode = .Cells(lTgtRow, iCol) 
            If (dicJobTitle.Exists(sJobTitle)) _ 
            Then 
               dicJobTitle(sJobTitle) = dicJobTitle(sJobTitle) & "~" & sName & "|" & sRotation & "|" & sReasonCode 
            Else 
               dicJobTitle.Add Key:=sJobTitle, Item:=sName & "|" & sRotation & "|" & sReasonCode 
            End If 
         End If 
      Next 
   End With 
    
   With Sheets(sDiary) 
      lDetailRow = 8 
      .Range(.Cells(lDetailRow, 1), .Cells(.Rows.Count, .Columns.Count)).Clear 
       
      For Each vOption In dicJobTitle 
         sJobTitle = CStr(vOption) 
         .Cells(lDetailRow, "C") = sJobTitle 
          
         lDetailRow = lDetailRow + 1 
         arrRecGroup = Split(CStr(dicJobTitle(sJobTitle)), "~") 
         For lRecGroup = LBound(arrRecGroup) To UBound(arrRecGroup) 
            arrRecDetail = Split(arrRecGroup(lRecGroup), "|") 
             
               .Cells(lDetailRow, "C") = arrRecDetail(0) 
               .Cells(lDetailRow, "D") = arrRecDetail(1) 
               .Cells(lDetailRow, "E") = arrRecDetail(2) 
               lDetailRow = lDetailRow + 1 
         Next lRecGroup 
         lDetailRow = lDetailRow + 1 
      Next 
   End With 
    
End Sub 


Function getItemRowLocation(sLookFor As String, _ 
                            sSheetName As String, _ 
                            Optional myRange As Range = Nothing, _ 
                            Optional bFullString As Boolean = True, _ 
                            Optional bLastOccurance As Boolean = True) As Long 
' get last use row on the sheet 

   Dim Cell             As Range 
   Dim iLookAt          As Integer 
   Dim iSearchDir       As Integer 
  ' Dim rngFirst         As Range 
   Dim rngSearch        As Range 
    
   If (bFullString) _ 
   Then 
      iLookAt = xlWhole 
   Else 
      iLookAt = xlPart 
   End If 
    
   If (bLastOccurance) _ 
   Then 
      iSearchDir = xlPrevious 
   Else 
      iSearchDir = xlNext 
   End If 
    
   If myRange Is Nothing _ 
   Then 
      Set rngSearch = Sheets(sSheetName).Cells 
   Else 
      Set rngSearch = Sheets(sSheetName).Range(myRange.Address) 
   End If 
    
   With rngSearch 
      If (bLastOccurance) _ 
      Then 
         Set Cell = .Find(sLookFor, .Cells(1, 1), , iLookAt, xlByRows, iSearchDir) 
      Else 
         Set Cell = .Find(sLookFor, .Cells(.Rows.Count, .Columns.Count), , iLookAt, xlByRows, iSearchDir) 
      End If 
   End With 
    
   If Cell Is Nothing Then 
      getItemRowLocation = 0 
   Else 
      getItemRowLocation = Cell.Row 
   End If 
   Set Cell = Nothing 
   Set rngSearch = Nothing 
End Function 


Function getLastColumn(sSheetName As String, Optional myRange As Range = Nothing) As Long 
' get last use row on the sheet 

   Dim Cell      As Range 
    
   If (myRange Is Nothing) _ 
   Then 
      Set Cell = Sheets(sSheetName).Cells.Find("*", Cells(1, 1), , , xlByColumns, xlPrevious) 
   Else 
      Set Cell = Sheets(sSheetName).Range(myRange.Address).Find("*", Sheets(sSheetName).Range(myRange.Address).Cells(1, 1), , , xlByColumns, xlPrevious) 
   End If 
   If Cell Is Nothing Then 
      getLastColumn = 0 
   Else 
      getLastColumn = Cell.Column 
   End If 
   Set Cell = Nothing 

End Function