How do you copy conditional information into a seperate worksheet

[Peterw_2506]

Hi everybody,

I have been looking for a while now for a solution to a problem I have and I can’t find anything close in excel formula. I think the only way to resolve this problem is in VBA (starting picking up the books and let’s learn VBA for Dummies).

OK the problem; I have an eighteen (18) worksheet workbook of which twelve (12) worksheets have critical data that require referencing to the thirteenth (13) worksheet. Each worksheet has about sixty rows of data ranging from Column “A” to Column “AO”. The number of rows varies on each worksheet but it always commences at Row 6. Column “C” is dedicated to informing whether an issue in its respective row is either “open”, “closed”, or a “date” appears indicating when that issue has to be finalised by and returned. It is the last issue that I am trying to resolve. I need to produce a formula that when the date in Column “C” is reached or past the data for that entire row (column “A” to Column “AO”) is referenced automatically into this 13^th worksheet until it is closed and the date is removed from that cell “C”.

I think further information required:

• · The name of the thirteenth sheet is called “RFS’s + 14 – 2 days”

The name of the twelve worksheets where the data is to be sourced from is;[FONT=&quot]
[/FONT]

• · “Package B - Ext. Arch. – Civil”
• · “Package B - Ext. Elect. – Plumb”
• · “Package C2 – ARCH”
• · “Package C2 - FF&E”
• · “Package C2 – ELECT”
• · “Package C2 – MECH”
• · “Phase D1”
• · “Phase D2”
• · “Phase D3 + D4”
• · “Phase D5”
• · “Phase D7”
• · “Package H”

The excel code that works and is in cell A2 is “=if('Package B - Ext. Arch. – Civil '!C6:C100>=today()…… but I don’t know how to take further. If somebody can help me with this I would be very grateful to you. I think you are all going to tell me it can only be done in VBA.

Regards,
Peter

 

[pbornemeier]

I cannot think of a way to do it with cell formulas.

Here is one way to do it with VBA code. See link in my sig on how to use it. Please test it on a copy of your worksheet.

The first subroutine will erase all of your input data, but I included it so the second subroutine could be tested.

Option Explicit

Sub CreateWorksheetsAndDummyData()

    Dim varyWorksheets As Variant
    Dim lX As Long
    Dim lY As Long
    Dim iAnswer As Integer
    
    iAnswer = MsgBox("This will delete the input and summary worksheets.  Do you want to continue?", vbYesNo + vbDefaultButton2, "Delete Data?")
    If iAnswer = vbYes Then
    
        varyWorksheets = Array("Package B - Ext. Arch. – Civil", "Package B - Ext. Elect. – Plumb", "Package C2 – ARCH", "Package C2 - FF&E", "Package C2 – ELEC", "Package C2 – MECH", "Phase D1", "Phase D2", "Phase D3 + D4", "Phase D5", "Phase D7", "Package H", "RFS’s + 14 – 2 days")
        Application.DisplayAlerts = False
        For lX = LBound(varyWorksheets) To UBound(varyWorksheets)
            On Error Resume Next
            Worksheets(varyWorksheets(lX)).Delete
            On Error GoTo 0
            Worksheets.Add(after:=Sheets(Sheets.Count)).Name = varyWorksheets(lX)
            With ActiveSheet
                For lY = 6 To 10
                    .Cells(lY, 1) = lX
                    .Cells(lY, 2) = lX
                    .Cells(lY, 3) = Int(Now()) - 8 + lY
                    .Range(Cells(lY, 4), Cells(lY, 45)) = lX * lY
                Next
            End With
        Next
    End If
    
End Sub

Sub CopyConditionalDataToSummarySheet()

    Dim varyWorksheets As Variant
    Dim sSummarySheet As String
    Dim lNextWriteRow As Long
    Dim lLastInputRow As Long
    Dim lX As Long
    Dim lY As Long
    
    sSummarySheet = "RFS’s + 14 – 2 days"
    varyWorksheets = Array("Package B - Ext. Arch. – Civil", "Package B - Ext. Elect. – Plumb", "Package C2 – ARCH", "Package C2 - FF&E", "Package C2 – ELEC", "Package C2 – MECH", "Phase D1", "Phase D2", "Phase D3 + D4", "Phase D5", "Phase D7", "Package H")

    'Erase current data from Summary worksheet
    With Worksheets(sSummarySheet)
        If .Cells.SpecialCells(xlCellTypeLastCell).Row > 6 Then
        .Rows("6:" & .Cells.SpecialCells(xlCellTypeLastCell).Row).EntireRow.Delete
    End If
    End With
    lNextWriteRow = 6
    
    'Copy rows that meet condition from each input worksheet to Summary worksheet
    For lX = LBound(varyWorksheets) To UBound(varyWorksheets)
        With Worksheets(varyWorksheets(lX))
            lLastInputRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            For lY = 6 To lLastInputRow
                If .Cells(lY, 3) >= Int(Now()) Then
                    .Range(.Cells(lY, "A"), .Cells(lY, "AO")).Copy _
                        Destination:=Worksheets(sSummarySheet).Cells(lNextWriteRow, 1)
                    lNextWriteRow = lNextWriteRow + 1
                End If
            Next
        End With
    Next

End Sub

I assumed the first row to meet the criterion should be written to row 6 of the 13th sheet.

 

[Peterw_2506]

Hi Phil,

Firstly thank you for your help, I knowkedgebase is only basic rudimentary when it comes to VBA if that so all your help is greatly appricated.

feed back;

OK pasted the formula in, in this order and this is the responses I got;
1st paste - pasted it into "The Workbook" section and ran the formula a 76 page document occurred with all the formating and cell links blown - OK wrong area.
2nd Attempt - paste formula into Sheet17 (RFS’s + 14 – 2 days) and ran "CreateWorksheetsAndDummyData" formula and this message came up "This will delete the input and summary worksheets. Do you want to continue?" - yes another dialog box came up stating "Application-defined or object-defined error" then terminated.
3rd Attempt - and ran "CopyConditionalDataToSummarySheet" formula
dialog box came up stating subscript out of range.

Looking at what had occurred a new sheet has been created at the rear of the workbook called "Package B - Ext. Arch. - Civil" a copy of the original name but no data except for row 6 which in col A a zero appeared, Col B same as Col. A, Col. C a date stating 10/3/11. Observation in the original Sheet there is nothing high-lighted that would trigger it to copy this.

My workbook sheet layout is like this;
Sheet1 (Summary Sheet) – Not involved in VBA formula/not to be targeted<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
Sheet2 (Legend) – Not involved in VBA formula/not to be targeted<o></o>
Sheet3 (Package B - Ext. Arch. – Civil)<o></o>
Sheet4 (Package B - Ext. Elect. – Plumb)<o></o>
Sheet5 (Package C1)<o></o>
Sheet6 (Package C2 – ARCH)<o></o>
Sheet7 (Package C2 - FF&E)<o></o>
Sheet8 (Package C2 – ELECT)<o></o>
Sheet9 (Package C2 – MECH)<o></o>
Sheet10 (Package C2 – Returned RFS’s) – Not involved in VBA formula/not to be targeted<o></o>
Sheet11 (Phase D1)<o></o>
Sheet12 (Phase D2)<o></o>
Sheet13 (Phase D3 + D4)<o></o>
Sheet14 (Phase D5)<o></o>
Sheet15 (Phase D7)<o></o>
Sheet16 (Package H)<o></o>
Sheet17 (RFS’s + 14 – 2 days)<o></o>
Sheet18 (Weekly Statistic Summary Sheet) – Not involved in VBA formula/not to be targeted

So I do not know if this feedback helps you in resolving issues or even if it is meant to operate like this as I have no understand about code but I do have my head in books at present.

If I can help just send me a message.

regards, Peter

 

[pbornemeier]

The CreateWorksheetsAndDummyData procedure in post #2 was created to allow testing the other procedures. Do not run it in your workbook since it will delete all dta from your source worksheets.

1) Make a copy of your workbook and save it so the data will be available, if the procedure eats your data.
2) Create a blank module in your workbook as per http://www.mrexcel.com/articles/paste-macro-into-vbe.php. The module must be in your workbook, not your personal.xlsb workbook.
3) Paste this code into the blank module in your workbook:

Option Explicit

Sub VerifyWorksheetNames()
    'Check that worksheets in the varyWorsheets array are in the workbook
    
    Dim varyWorksheets As Variant
    Dim lX As Long
    Dim lY As Long
    Dim sError As String
    Dim bFound As Boolean
    
    varyWorksheets = Array("Package B - Ext. Arch. – Civil", "Package B - Ext. Elect. – Plumb", "Package C2 – ARCH", "Package C2 - FF&E", "Package C2 – ELEC", "Package C2 – MECH", "Phase D1", "Phase D2", "Phase D3 + D4", "Phase D5", "Phase D7", "Package H", "RFS’s + 14 – 2 days")
    Application.DisplayAlerts = False
    
    sError = ""
    
    For lX = LBound(varyWorksheets) To UBound(varyWorksheets)
        bFound = False
        For lY = 1 To Sheets.Count
            If Sheets(lY).Name = varyWorksheets(lX) Then
                bFound = True
                Exit For
            End If
        Next
        If Not bFound Then
            sError = sError & varyWorksheets(lX) & vbLf
        End If
    Next

    If Len(sError) > 0 Then
        sError = "1) The following worksheet name(s) are not found in the workbook:" & vbLf & vbLf & sError
        sError = sError & vbLf & "Edit the line of code that starts with 'varyWorksheets = Array(' so the worksheet name(s) listed above are in it." & vbLf & _
            "2) Worksheets names are not case sensetive, but the spelling, spacing and punctuation must match exactly." & vbLf & _
            "3) Ensure the changes are made to the line in both of these prodcedures: VerifyWorksheetNames & CopyConditionalDataToSummarySheet" & vbLf & _
            "4) Rerun this procedure after the corrections until no error is reported."
    Else
        sError = "All worksheets named in the code are present."
    End If
    MsgBox sError
    
End Sub


Sub CopyConditionalDataToSummarySheet()

    Dim varyWorksheets As Variant
    Dim sSummarySheet As String
    Dim lNextWriteRow As Long
    Dim lLastInputRow As Long
    Dim lX As Long
    Dim lY As Long
    
    sSummarySheet = "RFS’s + 14 – 2 days"
    varyWorksheets = Array("Package B - Ext. Arch. – Civil", "Package B - Ext. Elect. – Plumb", "Package C2 – ARCH", "Package C2 - FF&E", "Package C2 – ELEC", "Package C2 – MECH", "Phase D1", "Phase D2", "Phase D3 + D4", "Phase D5", "Phase D7", "Package H")

    'Erase current data from Summary worksheet
    With Worksheets(sSummarySheet)
        If .Cells.SpecialCells(xlCellTypeLastCell).Row > 6 Then
        .Rows("6:" & .Cells.SpecialCells(xlCellTypeLastCell).Row).EntireRow.Delete
    End If
    End With
    lNextWriteRow = 6
    
    'Copy rows that meet condition from each input worksheet to Summary worksheet
    For lX = LBound(varyWorksheets) To UBound(varyWorksheets)
        With Worksheets(varyWorksheets(lX))
            lLastInputRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            For lY = 6 To lLastInputRow
                If .Cells(lY, 3) >= Int(Now()) Then
                    .Range(.Cells(lY, "A"), .Cells(lY, "AO")).Copy _
                        Destination:=Worksheets(sSummarySheet).Cells(lNextWriteRow, 1)
                    lNextWriteRow = lNextWriteRow + 1
                End If
            Next
        End With
    Next

End Sub

4) Run the VerifyWorksheetNames procedure to verify that the worksheet names in the VerifyWorksheetNames procedure match the worksheet names in the workbook. If any names are reported missing, edit the line that starts with varyWorksheets = Array( in the VerifyWorksheetNames procedure and re-run it until no errors are reported.

5a) If you made any edits in step 4, replace the varyWorksheets = Array( line in the CopyConditionalDataToSummarySheet procedure with the one from the VerifyWorksheetNamesthat you edited.

5b) *** Very IMPORTANT *** Remove ,"RFS’s + 14 – 2 days" from the end of the varyWorksheets = Array( line in the CopyConditionalDataToSummarySheet procedure.

6) Run the CopyConditionalDataToSummarySheet procedure.