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]

Try

Sub test()
Dim LR As Long, i As Long
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" Or .Value = "y" Then
                .Offset(, -5).Resize(, 13).Copy Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
            End If
        End With
    Next i
End With
End Sub

 

[jduzz]

Thanks a million for that.

What I forgot to mention is that in Sheet2, I first want all the rows with 'x', then a blank row, and then all the rows with 'y'...

 

[VoG]

Try

Sub test()
Dim LR As Long, i As Long
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 Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
            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 Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
            End If
        End With
    Next i
End With
End Sub

 

[jduzz]

Peter, I have tried it on an empty workbook and it works brilliantly!!!

Thanks a million for that!

I will now try build it into my existing excel file...


Regards


JD

 

[jduzz]

Peter, it seems that in my existing worksheet, it only copies the last row with 'x' and after that the last row with 'y', without an empty row between it.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
This while in a new workbook it works fine.<o></o>
<o> </o>
What could this be about?<o></o>
<o></o>
Also two other questions<o></o>
<o></o>
1. I have a number of date fields (DD-MM-YY in columns G and H) that contain the outcome of a calculation from a weeknumber (so the cell has a formula). Can this outcome be copied into sheet2? (Now I get a bunch of symbols)<o></o>
<o></o>
2. I have a few numeric fields (0.0 in columns I thru M) that each contain a link to a similar numeric field in a third sheet. Can these be copied into sheet2? (now I get a number, but from completely wrong rows)<o></o>
<o></o>
Thanks again!<o></o>
<o></o>
<o></o>
JD<o></o>

 

[VoG]

I don't know why it would only copy one row of each - for me it copies them all. Could some cells contain spaces - i.e. "x " instead of "x"?

This will paste values

[IMG]file:///C:/DOCUME%7E1/PETERJ%7E1/LOCALS%7E1/Temp/moz-screenshot-8.png[/IMG]Sub test()
Dim LR As Long, i As Long
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
            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
            End If
        End With
    Next i
End With
End Sub

 

[jduzz]

Peter, the values are now copied perfectly.

Two more issues:

1. When the macro runs, the screen flickers.

2. In regards to the idea of having spaces in the status fields: I have filled in a '0' in all status fields, then change a few with x and y, no difference: it only copies the last x and then the last y (without an empty row).

- Released macro security
- Unfreeze sheet1 header
- Unprotect all sheets
- ?

Does not help. What on earth can that be? If it works in a new excel file, why not in my existing one?

 

[VoG]

This should stop the flicker. Sorry but I don't know why not all rows are being copied.

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
            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
            End If
        End With
    Next i
End With
Application.ScreenUpdating = True
End Sub

 

[jduzz]

The only possible explanation could be: might this have to do with the fact that I am using conditional formatting formulas in Sheet1 (to color the cells)?<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
By the way: where the macro used to also copy the color of the different rows, using the last code you sent, it does not do this anymore?<o></o>
<o></o>
Thanks again!<o></o>
<o> </o>