Find first empty row in a range

[anon]

Hi,

I'm looking for my user to select a button which will take a date
entered in sheet 1 and find it in sheet 2. I then want to enter some
text in the column where the date was found.
However; I need to post the text in the first empty row in the next 13
rows below the date, excluding the row directly below the date. Eg. if
the date is found in a1 it will enter the text in the first empty row
between a3:a14. If the date is found in D20 it would paste text in the
first empty row in the range d21:d33.

I also need an action if there are no empty rows in this range ie. a
msg box to warn the user that the text has not been pasted.

I've started with some code as below;

RESULT = Application.InputBox("What date would you like to plan for?"
& vbNewLine & "Enter the date as dd/mm/yy", "Call planning date",
Type:=2)
If RESULT = "" Then
MsgBox ("You have not entered a valid date, please try again")
Else
sheets("planner").activate
activesheet.range("A1").activate
with activesheet
cells.find(what:=RESULT, After:=activecell, LookIn:=xlvALUES, LookAt:=
_
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False) _
'action if not found
else
'find first empty row in the next 14 rows below the found cell
excluding the row directly below the found cell
'if no empty rows do an action
'otherwise paste "FOUND" in the empty row
End Sub

Any help will be gratefully received. Thanks,

 

[Per Jessen]

Hi

Try this

Sub Anon()

EnterDate:
Do
Result = Application.InputBox("What date would you like to plan for?" &
vbNewLine & "Enter the date as dd/mm/yy", "Call planning date", Type:=2)
Loop Until Result <> ""
If Val(Result) = False Then End ' User hit Cancel

Sheets("planner").Activate
Range("A1", Range("A65536").End(xlUp)).Select


Set c = Selection.Find(What:=Result, After:=ActiveCell, LookIn:=xlValues,
LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False)
If c Is Nothing Then
MsgBox ("You have not entered a valid date, please try again")
GoTo EnterDate
Else
tRow = c.Row + 1
For r = 14 To 1 Step -1
If Cells(tRow + r, 1).Value = "" Then ' Check column A for data
dRow = tRow + r
End If
Next
If dRow = "" Then
Msg = MsgBox("No empty row available !", , "Warning")
Else
Cells(dRow, 1).Select
ActiveSheet.Paste Destination:=Cells(dRow, 1)
End If

End If
End Sub

Regards,

Per