Copying to next unused row

[Ken]

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

http://groups.google.com/group/micr...s/browse_thread/thread/2aa9493d568be5ff?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

 

[Per Jessen]

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]

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

 

[Per Jessen]

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

 

[Ken]

"Ken" <[email protected]> skrev i meddelelsen



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 searchfor.
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 Qare 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

 

[Per Jessen]

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