Question

Developing using Excel 2007, but need to be compatible with 2003.

Problem:

Workbook has two sheets. Sheet two contains data, columns A thru M. Column C is formatted for Date values. Not all rows contain a value in column C.

Sheet One has 3 ‘Option Buttons (form Control), labeled Contract date, Effective Date, and End Date. When contract date is selected, Need data on sheet two, column C (Date is contained here) to be queried with a conditional filter… If date < today’s date + 14 days … If true, copy column C thru M of that row to Sheet One beginning at cell C13. Continue until all data rows have been tested.

If another ‘Option Button’ is selected, results from first query are replaced by results from second query.

Here is the code I have been working on, but it won’t work.

Sub OptionButton1_Click()

    Application.ScreenUpdating = False

    TEMPLATE_SHEET = "Data_Input"

    Database_sheet = "Carrier"

    myzerorange = "C" & ActiveWindow.RangeSelection.Row & ":" & "M" & ActiveWindow.RangeSelection.Row

    mycompany = "C" & ActiveWindow.RangeSelection.Row

    mydate = "D" & ActiveWindow.RangeSelection.Row

    Database_sheet = ActiveSheet.Name

    DATABASE_RECORDS = Sheets(Database_sheet).Range("C2:C1000") Count_Row = 13

    If Range(mycompany) <> "" Then

        If Range(mydate) <> "" Then

           'Range(mydate) = contractdate
               If mydate < DateAdd("d", 14, "Today()") Then

                   Range(myzerorange).Copy
                   Sheets(TEMPLATE_SHEET).Select

                   'To identify the next blank row in the database sheet

                   DATABASE_RECORDS = Sheets(TEMPLATE_SHEET).Range("C13:C1000")
                   'To identify the next blank row in the data_Input sheet
                   For Each DBRECORD In DATABASE_RECORDS
                       If DBRECORD <> "" Then
                        Count_Row = Count_Row + 1
                       Next DBRECORD

                   Sheets(TEMPLATE_SHEET).Range("C" & Count_Row).Select
                   ActiveSheet.Paste

                   'Return to origin and check for another contract date
                   Sheets(Database_sheet).Select
               Else

               End If
        Else

        End If

    End If

    Application.ScreenUpdating = True

End Sub

This revised code still doesn’t work… not sure what is hanging this up…

Sub CopyRowConditional()

    Application.ScreenUpdating = False

    Srownumber = 2 'source sheet row number "Data_Input"

    Trownumber = 13 'target sheet row number "Carrier"

    Do

        Srownumber = Srownumber + 1

        Trownumber = Trownumber + 1

        If Cells(Srownumber, 3).Value = "" Then Exit Do

            If Cells(Srownumber, 4).Value < DateAdd("d", 14, "Today()") Then

               For Column = 3 To 13

                   Sheets(template_sheet).Cells(Trownumber, Column).Value = >Sheets(Database_sheet).Cells(Srownumber, Column).Value

               Next Column
            End If

        End If

    Loop

    Application.ScreenUpdating = True

End Sub

Answer 1

This is what I have in mind for your problem. See the comments. You need to bind the button click to CopyRowConditional.

Sub CopyRowConditional()

Do

i = i + 1

    If Cells(i, 1).Value = "" Then Exit Do
                    ' this is to exit the loop when you reach an empty row

    If Cells(i, 1).Value = 10 Then ' this is where you put
                    ' the condition that triggers the copy
                    ' here I just put 10 as an example

        TargetRow = 4 ' this is where you need to determine how
                      ' you select the row that will receive the
                      ' data you're copying in the Target sheet
                      ' If you need to check for an empty row
                      ' you can add a Do ... Loop statement
                      ' that stops when the row is good

        For j = 1 To 14 ' this is where you loop in to the
                        'column of the Source sheet

        Sheets("Target").Cells(TargetRow, j).Value = Sheets("Source").Cells(i, j).Value
        ' this is the line that actually does the copying, cell by cell
        ' if you need to change the column index, just write .Cells(i, j+ n).value
        ' where n is any offeset you need


        Next j

    End If

Loop

End Sub