Hi again Ken

Try to see if this is what you need. See my comments in the code. Once the
date for monday is entered it should loop through to friday.

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

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 And Cells(LSearchRow,
"O").Value _
= "" And Cells(LSearchRow, "Q").Value = "" Then
'Select row in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Copy

'Paste row into WeeklyDueLog in next row
Sheets("WeeklyDueLog").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Paste

'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
Rows(LCopyToRow).Delete
LCopyToRow = LCopyToRow + 1
LSearchValue = Month(LSearchValue) & "/" & Day(LSearchValue) + 1 &
"/" & Year(LSearchValue)
'Check to see if dateformat is correct
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

Best regards,
Per

"Ken" skrev i meddelelsen
...

Hello again group!
I have resolved all issues with my macro as it pertains to this
thread:

http://groups.google.com/group/micro...568be5ff?hl=en

I wasn't sure whether I should have continued the above thread or
start a new one, so if I have not followed one of the guidelines, my
sincere apologies.
The macro I'm using searches for data pertaining to a date that I
enter, finds it and pastes it to Row 4 downward, using as many rows as
it needs. The problem is that it overwrites cells that I have on the
sheet already. This is a screenshot of the sheet:
http://www.elodgingatbristol.com/WeeklyDueLog.htm
What can be added, or changed on this macro to accomplish the
following:
After the first date is searched, and there are results, copy to row
4, going down as many rows as needed, pushing downward the rows on the
sheet that are occupied (Tuesday header), etc. If there is no data to
paste, enter into Row 4 something like "No jobs due on this date.",
just to use the row so it won't be the first available row. Then my
next search will be Tuesday's date, whatever I enter, and the data
will be entered on the blank row under Tuesday's header, using as many
rows as it needs, pushing Wednesday's header down the
sheet...etc...etc...
This is the completed macro:
Sub SearchForString2()

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

On Error GoTo Err_Execute

LSearchValue = InputBox("Please enter a value to search for.
Entering no date, all with no Due Date will copy.", "Enter value")

'Start search in row 2 in JobLogEntry
LSearchRow = 2

'Start copying data to row 4 in WeeklyDueLog (row counter
variable)
LCopyToRow = 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 And
Cells(LSearchRow, "O").Value = "" And Cells(LSearchRow, "Q").Value =
"" Then
'Select row in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy

'Paste row into WeeklyDueLog in next row
Sheets("WeeklyDueLog").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

'Move counter to next row
LCopyToRow = LCopyToRow + 1

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

End If

LSearchRow = LSearchRow + 1

Wend

'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

If there is a way to accomplish this, your input will be greatly
appreciated...if there isn't, I can always copy to a blank sheet, cut
and paste manually if I need to. So it's not critical, but sure would
make this macro the ultimate! Thanks in advance for all!
Ken