On Jun 23, 5:01*pm, "Per Jessen" wrote:
"Ken" skrev i ...



Hi Per,
*I have been trying your suggested code, but it is searching the log
and deleting those lines with the due date specified in the input box,
and each date that week, and doesn't copy the line. I'm pretty certain
I've copied your code correctly. Any suggestions?? Thank you so much
for your help!
Ken

Hi Ken

The previous code wasn't tested -:(

Here's a tested version, that should work. I have added a function to
calculate correct next date.

Sub SearchForString2()

* * Dim LSearchRow As Integer
* * Dim LCopyToRow As Integer
* * Dim LSearchValue As String

* * On Error GoTo Err_Execute

* * 'Force user to enter date
* * Do
* * * * LSearchValue = InputBox("Please enter a value to search for.
Entering no date, all with no Due Date will copy.", "Enter value")
* * Loop Until LSearchValue < ""

* * sDate = Day(LSearchValue)
* * 'Start search in row 2 in JobLogEntry

* * Sheets("JobLogEntry").Select
* * LSearchRow = 2

* * 'Start copying data to row 4 in WeeklyDueLog (row counter variable)
* * LCopyToRow = 4
* * For sDay = 0 To 4
* * * * While Len(Range("A" & CStr(LSearchRow)).Value) 0

* * * * 'If value in column J = LSearchValue, and column O or Q are empty,
copy entire row to WeeklyDueLog
* * * * If Cells(LSearchRow, "J").Value = LSearchValue Then *'And
Cells(LSearchRow, "O").Value _
* * * * * * = "" And Cells(LSearchRow, "Q").Value = "" Then

* * * * * * * * 'Select row in Sheet1 to copy
* * * * * * * * Rows(CStr(LSearchRow)).Copy

* * * * * * * * 'Paste row into WeeklyDueLog in next row
* * * * * * * * Sheets("WeeklyDueLog").Select
* * * * * * * * ActiveSheet.Paste Cells(LCopyToRow, 1)

* * * * * * * * 'Insert new row
* * * * * * * * LCopyToRow = LCopyToRow + 1
* * * * * * * * Rows(LCopyToRow).Insert

* * * * * * * * 'Go back to JobLogEntry to continue searching
* * * * * * * * Sheets("JobLogEntry").Select

* * * * * * End If

* * * * * * LSearchRow = LSearchRow + 1

* * * * Wend
* * * * Sheets("WeeklyDueLog").Rows(LCopyToRow).Delete
* * * * LCopyToRow = LCopyToRow + 1

* * * * LSearchValue = NextDay(LSearchValue)
* * * * 'Check to see if dateformat is correct
* * * * LSearchRow = 2
* * Next
* * 'Position on cell A3
* * Application.CutCopyMode = False
* * Range("A3").Select

* * MsgBox "All matching data has been copied."

* * Exit Sub

Err_Execute:
* * MsgBox "An error occurred."

End Sub

Function NextDay(LSearchValue)
d = Day(LSearchValue) + 1
m = Month(LSearchValue)
y = Year(LSearchValue)
NextDay = Format(d & "-" & m & "-" & y, "mm-dd-yyyy")
If IsDate(NextDay) = False Then
* * If m = 12 Then
* * * * y = y + 1
* * * * m = 1
* * * * d = 1
* * * * NextDay = Format(d & "-" & m & "-" & y, "mm-dd-yyyy")
* * Else
* * * * m = m + 1
* * * * d = 1
* * * * NextDay = Format(d & "-" & m & "-" & y, "mm-dd-yyyy")
* * End If
End If
End Function

Regards,
Per

Thanks, Per....it will take me a day or two to test, and I'll get back
to you....my utmost appreciation!
Ken