title: VBA to copy data and insert rows based on criteria
body: <p>I am working on a task wherein I get calendar for a individual in a specific format as below:</p>
  
  <p>Sheet1
  Column A - Date
  Column B - Location
  Column C - Departure Date (in text format 10-Jan-2017 10:00 AM)
  Column D - Arrival Date (in text format 10-Jan-2017 10:00 AM)
  Column E - New Location
  Column F - Notes</p>
  
  <p>The tasks I need to perform are as below:</p>
  
  <ol>
  <li>Copy Sheet1 data to Sheet2</li>
  <li>While copying data, I need to insert rows based on the below criteria</li>
  </ol>
  
  <p>If Column C Departure Date and Column D Arrival Date is on the same day, then insert a new row with values as below:</p>
  
  <p>Column A - Same date as per the row above
  Column B - New Location from Column E as per the row above
  Column C - BLANK
  column D - BLANK
  Column E - BLANK
  Column F - BLANK</p>
  
  <p>If Column C Departure Date and Column D Arrival Date are different dates, then no need to insert rows, follow same sequence as data from Sheet1.</p>
  
  <p>I used the below code, but facing 2 issues as mentioned below:</p>
  
  <p>-This code only works on Sheet1. Can you help me add this to Sheet2, so I can have Sheet1 with the original data and Sheet2 with the results I need?
  - Also, the below code uses a text "INSERT" as the criteria. I want to change this to read Column C and Column D and if the dates are same, then add a new row below the date. (PLEASE REMEMBER THAT COLUMN C AND COLUMN D HAVE DATES IN TEXT FORMAT SO WE MAY HAVE TO USE A LEFT FUNCTION AS SUGGESTED BY MY FRIENDS HERE)</p>
  
  <pre><code>Private Sub CommandButton1_Click()
  
  Dim wksData As Worksheet
  Dim lngLastRow As Long, lngIdx As Long, _
  lngDateCol As Long, _
  lngReversalCol As Long, _
  lngLocationCountryCol As Long, _
  lngDestinationCountryCol As Long, _
  lngDepartureDateCol As Long, _
  lngArrivalDateCol As Long, _
  lngNotesCol As Long
  
  Dim varRowNum As Variant
  Dim colRowNumsForInsert As Collection
  Set colRowNumsForInsert = New Collection
  
  'Set references up-front
  lngDateCol = 1
  lngLocationCountryCol = 2
  lngDepartureDateCol = 3
  lngArrivalDateCol = 4
  lngDestinationCountryCol = 5
  lngNotesCol = 6
  
  
  Set wksData = ThisWorkbook.Worksheets("Sheet1")
  lngLastRow = LastOccupiedRowNum(wksData)
  
  'Loop through the data range BACKWARDS, tracking each case where a row will need to be in a collection
  With wksData
      For lngIdx = lngLastRow To 2 Step -1
  
          'If the Notes Column = "INSERT", though, we also need 'to note that row number so we can eventually add a new row there
          If .Cells(lngIdx, lngNotesCol) = "INSERT" Then
              colRowNumsForInsert.Add Item:=lngIdx, Key:=CStr(lngIdx)
          End If
  
      Next lngIdx
  
  
      'Now we just need to add rows where necessary and apply the right values
  
      'Loop through the row numbers in our collection, which are conveniently in REVERSE order (as adding rows will change the row numbers in the range, making forward looping very difficult)
      For Each varRowNum In colRowNumsForInsert
  
          'First, insert a new row, shifting everything below it down
          .Range("A" &amp; varRowNum).Offset(1).EntireRow.Insert Shift:=xlDown
  
          'Write the date (which are the same)
          .Cells(varRowNum + 1, lngDateCol) = .Cells(varRowNum, lngDateCol)
  
          'Write the new location (which is the new location from the row above)
          .Cells(varRowNum + 1, lngLocationCountryCol) = .Cells(varRowNum, lngDestinationCountryCol)
          .Cells(varRowNum, lngNotesCol) = ""
      Next varRowNum
  
  End With
  
  'Let the user know the script is done
  MsgBox "Finished!"
  
  End Sub
  
  
  'INPUT       : Sheet, the worksheet we'll search to find the last row
  'OUTPUT      : Long, the last occupied row
  'SPECIAL CASE: if Sheet is empty, return 1
  
  Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
  Dim lng As Long
  If Application.WorksheetFunction.CountA(Sheet.Cells) &lt;&gt; 0 Then
      With Sheet
          lng = .Cells.Find(What:="*", _
                            After:=.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
      End With
  Else
      lng = 1
  End If
  LastOccupiedRowNum = lng
  
  End Function
  </code></pre>