How to create macro that conditionally copies parts of rows from a main sheet to a summary sheet.

[jduzz]

Dear all, I have only recently started with Excel and need help with what I think is a relatively easy problem:
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>a) I have a sheet1, it has many rows, in column F there is a status field (sheet1.value = ‘a’, ‘b’, ‘c’, ‘x’ or ‘y’)
b) I maintain this sheet, change whatever I want
c) When finished I want to copy a subset of sheet1 to sheet2 by pushing a button (w. a macro) in sheet1
d) When I push this button all rows in sheet1 where status is ‘x’ or ‘y’ should be copied into sheet2
e) Not the entire rows should be copied into sheet2, only the first 14 fields (the fields in column A through column M)
f) When I maintain sheet1 again, and push the button again, the data in sheet2 that I just generated must be entirely overwritten with the latest from sheet1.
<o></o>
That is really it.
I have tried this now for days but I cannot make it work unfortunately .
Your help is very much appreciated.

 

[VoG]

Conditional formatting shouldn't have an effect. This should copy the colours

Sub test()
Dim LR As Long, i As Long
Application.ScreenUpdating = False
Sheets("Sheet2").UsedRange.ClearContents
With Sheets("Sheet1")
    LR = .Range("F" & Rows.Count).End(xlUp).Row
    For i = 1 To LR
        With .Range("F" & i)
            If .Value = "x" Then
                .Offset(, -5).Resize(, 13).Copy
                Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
                Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteFormats
            End If
        End With
    Next i
    Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = " "
    For i = 1 To LR
        With .Range("F" & i)
            If .Value = "y" Then
                .Offset(, -5).Resize(, 13).Copy
                Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
                Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteFormats
            End If
        End With
    Next i
End With
Application.ScreenUpdating = True
End Sub

 

[jduzz]

Okay, it has nothing to do with the conditional formatting: I deleted all formulas, saved it under a new name, no change at all...

Would it be an idea to send you the file?

 

[VoG]

If it doesn't contain confidential information try uploading it to a site like www.box.net and provide a link.

 

[jduzz]

Okay Peter, here is the link:

http://www.box.net/shared/o75791qpn3icgqxopn16

You will see in sheet 'Level 1' the status field in column F (made it a drop down, just to see if this would solve the issue, does not). If you click on the little icon on top of the sheet (puppet behind desk) then you generate the list in the Summary sheet.

Meanwhile I will continue to find out what on earth this can be.

Thanks and talk to you soon..

 

[VoG]

It was because column A is blank. Try this

Sub test()
Dim LR As Long, i As Long, j As Long
Application.ScreenUpdating = False
Sheets("Sheet2").UsedRange.ClearContents
With Sheets("Sheet1")
    LR = .Range("F" & Rows.Count).End(xlUp).Row
    For i = 1 To LR
        With .Range("F" & i)
            If .Value = "x" Then
                j = j + 1
                .Offset(, -5).Resize(, 13).Copy
                Sheets("Sheet2").Range("A" & j).PasteSpecial Paste:=xlPasteValues
                Sheets("Sheet2").Range("A" & j).PasteSpecial Paste:=xlPasteFormats
            End If
        End With
    Next i
    j = j + 1
    For i = 1 To LR
        With .Range("F" & i)
            If .Value = "y" Then
                j = j + 1
                .Offset(, -5).Resize(, 13).Copy
                Sheets("Sheet2").Range("A" & j).PasteSpecial Paste:=xlPasteValues
                Sheets("Sheet2").Range("A" & j).PasteSpecial Paste:=xlPasteFormats
            End If
        End With
    Next i
End With
Application.ScreenUpdating = True
End Sub

 

[jduzz]

It works!!

Thanks a million for your brilliant help and patience!

 

[jduzz]

Frankly I would be tempted to send you something out of gratitude, bottle of gin perhaps, but I dont know your address or anything.

So let me just say that I do find it refreshingly kind of you to make all that effort.

Its inspiring.

 

[jduzz]

Peter, if you still there one more question: if I would include a field in the far right column of sheet1 (column BO) with a document link, how would your routine change to copy that one field at the end of the copy string that is now made (so in sheet2, column N)? Would the link then still work on the second sheet?

 

[VoG]

This will copy it - I'm not sure whether the link will still work.

Sub test()
Dim LR As Long, i As Long, j As Long
Application.ScreenUpdating = False
Sheets("Sheet2").UsedRange.ClearContents
With Sheets("Sheet1")
    LR = .Range("F" & Rows.Count).End(xlUp).Row
    For i = 1 To LR
        With .Range("F" & i)
            If .Value = "x" Then
                j = j + 1
                .Offset(, -5).Resize(, 13).Copy
                Sheets("Sheet2").Range("A" & j).PasteSpecial Paste:=xlPasteValues
                Sheets("Sheet2").Range("A" & j).PasteSpecial Paste:=xlPasteFormats
                .Range("BO" & i).Copy Destination:=Sheets("Sheet2").Range("N" & j)
            End If
        End With
    Next i
    j = j + 1
    For i = 1 To LR
        With .Range("F" & i)
            If .Value = "y" Then
                j = j + 1
                .Offset(, -5).Resize(, 13).Copy
                Sheets("Sheet2").Range("A" & j).PasteSpecial Paste:=xlPasteValues
                Sheets("Sheet2").Range("A" & j).PasteSpecial Paste:=xlPasteFormats
                .Range("BO" & i).Copy Destination:=Sheets("Sheet2").Range("N" & j)
            End If
        End With
    Next i
End With
Application.ScreenUpdating = True
End Sub

 

[jduzz]

probably not, as the links back to the original row in sheet1 simply cannot work either unless it remembers from which sheet1 row the entry was copied..

Thanks anyway.