Hi,

I have been trying to copy and paste the names from a roster based on the date entered into an input box. I would like to look up the date in a row and use that column to search for certain shifts, then copy and paste the name in column A to a different location. All seems to work ok but the destination is selected but empty.

Any help would be gratefully appreciated...


Dim strdate As String
Dim Cname As String
Dim Rdate As Date
Dim LastRow As Integer
Dim i As Integer 'row counter
Dim rCell As Range
Dim lReply As Long

strdate = Application.InputBox(Prompt:="Enter a Date to Locate on This Worksheet", _
                Title:="ROSTER DATE", Default:=Format(Date, "Short Date"), Type:=1)

    If strdate = "False" Then Exit Sub
    strdate = Format(strdate, "Short Date")

On Error Resume Next

        Set rCell = Cells.Find(What:=CDate(strdate), After:=Range("A1"), LookIn:=xlFormulas _
            , LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)


With Sheets("Roster")
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With

For i = 4 To LastRow
    If Cells(i, rCell.Column) = "D" Then
    
         Range(Cells(i, 1)).Copy
         Range("B20").End(xlDown).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
        End If
Next i

On Error GoTo 0

    If rCell Is Nothing Then
        lReply = MsgBox("Date cannot be found. Try Again", vbYesNo)
        If lReply = vbYes Then Run "FindDate":
    End If