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

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

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

"Ken" skrev i meddelelsen
...

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

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

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

Hi Ken

Thanks for your reply, I look forward to hear about your test.
Per