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
Bookmarks