PDA

View Full Version : Solved: Copy Rows w/in a Range Only if Condition Met



jcfields
02-04-2009, 08:38 PM
Hey all,

I have small issue I can't figure out... (and I've tried the search but can't find the exact solution I'm looking for).

Anyway, here's the situation: I have a worksheet with data spanning a couple of thousand rows by 10 or so columns wide. The rows are sorted chronologically by a 'time' value in column A, and there is a parameter in column D (or whatever) that designates the info represented in that particular row as "pass" or "fail". If that value is "fail", I'd like to be able to copy selected cells from that particular row to a row in a new worksheet. The goal is for any row that contains the "fail" value in column D (or whatever) to be copied to the new worksheet, maintaining the chronologically sorted order of the original data. Oh, and I need to be able to paste values only on the new worksheet (e.g. I don't want to copy any formulas over from one worksheet to the other, just the calculated values in those cells). In short, I'm trying to generate a worksheet that condenses the original sheet down into one that only displays the data associated with the "fail" condition.

I'm sort of a lightweight when it comes to VBA (I'm assuming this will have to be done with a macro), so I appreciate any help ya'll can offer. Also, if it's not too much trouble, comments explaining what each piece of code is doing are very much appreciated. I'm sincerely trying to figure this VBA animal out, and I'll take any opportunity I can get to learn a little more. Thanks, and please let me know if I need to elaborate on my problem some more.

Jeremy

lucas
02-04-2009, 09:13 PM
Hi Jeremy,
I use a function in my example. I didn't go into the details you listed because you said you wanted to learn.

This code looks in column H or 8 for the word "withdrawn". If it is found then the entire row is copied to the sheet notices.

After you get this working and understand it a little better we will deal with sorting the copied data and removing the formula's.

Option Explicit
Sub Main()

Dim i As Long

For i = TargetRow(ActiveSheet, 1) - 1 To 2 Step -1
If UCase(ActiveSheet.Cells(i, 8).Value) = "WITHDRAWN" Then
ActiveSheet.Rows(i).Copy Sheets("Notices").Cells(TargetRow(Sheets("Notices"), 1), 1)
' ActiveSheet.Rows(i).Delete
End If
Next i

End Sub

Function TargetRow(ByRef ws As Worksheet, ByVal col As Long) As Long
'returns index of first empty row from bottom of sheet
'requires worksheet object and column index
TargetRow = ws.Cells(Rows.Count, col).End(xlUp).Row
If IsEmpty(ws.Cells(TargetRow, col)) Then
'in this case the column is empty
'change targetrow to 2 to move the rows starting on the second row
TargetRow = 1
Else
TargetRow = TargetRow + 1
End If
End Function


Add Option compare text just below Option explicit and you don't have to worry about whether the capitalization is accurate...just the string matches.

jcfields
02-04-2009, 10:24 PM
lucas,

Thanks for the quick response. I'll plug this into my worksheet tomorrow when I get to work and see if I can get it working. At first glance, it looks like it should do the trick (short of re-sorting the data and pasting values only, which I might be able to figure out on my own by using the record macro ability and scavenging the generated code). I'll let you know tomorrow, and thanks again.

Jeremy

jcfields
02-05-2009, 03:32 PM
lucas,

Thanks again for the help. I modified your macro a bit and added some stuff to get the results I wanted, and it seems to be doing the trick. I also managed to figure out what you're doing here, so no further explanations required after all :thumb. Here's what I ended up with:


Option Explicit
Sub RowCopy()
Application.ScreenUpdating = False
' Removes all data from Sheet2
Sheets("Failures").Select
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("Input").Select
' Copy rows that have failure data from Sheet1 to Sheet2
Dim i As Long

For i = TargetRow(ActiveSheet, 1) - 1 To 2 Step -1
If UCase(ActiveSheet.Cells(i, 26).Value) = "Y" Then
ActiveSheet.Rows(i).Select
Rows(i).Activate
Selection.Copy
Sheets("Failures").Select
Cells(TargetRow(Sheets("Failures"), 1), 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("Input").Select
' ActiveSheet.Rows(i).Delete
End If
Next i

' Copy column headings from Sheet1 to Sheet2
Rows("1:1").Select
Range("A1").Activate
Selection.Copy
Sheets("Failures").Select
Rows("1:1").Select
ActiveSheet.Paste

' Sorts failure data by krevs from smallest to largest
Sheets("Failures").Select
Cells.Select
Range("X1").Activate
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Failures").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Failures").Sort.SortFields.Add Key:=Range( _
"AL2:AL100"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Failures").Sort
.SetRange Range("A1:BA100")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub

Function TargetRow(ByRef ws As Worksheet, ByVal col As Long) As Long
'returns index of first empty row from bottom of sheet
'requires worksheet object and column index
TargetRow = ws.Cells(Rows.Count, col).End(xlUp).Row
If IsEmpty(ws.Cells(TargetRow, col)) Then
'in this case the column is empty
'change targetrow to 2 to move the rows starting on the second row
TargetRow = 1
Else
TargetRow = TargetRow + 1
End If
End Function


Thanks again for the help.:friends:

Jeremy

mdmackillop
02-05-2009, 03:41 PM
Hi Jeremy
This seems very odd
For i = TargetRow(ActiveSheet, 1) - 1 To 2 Step -1
Can you post your workbook so I can see what happens?

jcfields
02-05-2009, 03:45 PM
Hi Jeremy
This seems very odd
For i = TargetRow(ActiveSheet, 1) - 1 To 2 Step -1
Can you post your workbook so I can see what happens?

I can't post the workbook b/c it has some proprietary company stuff in it, but the example.xls file that lucas attached in the second post should illustrate for you what happens. In short, the macro starts looking at rows from the bottom of the page moving upward (hence the negative step value). So the rows are pasted in reverse order in the new worksheet. It's pretty slick. Kudos to lucas, 'cause I probably would've never came up with that on my own.

Cheers,
Jeremy

mdmackillop
02-05-2009, 04:11 PM
Avoid looping and selection where possible. Try the following
Option Explicit
Sub RowCopy()
Application.ScreenUpdating = False
' Removes all data from Sheet2
Sheets("Failures").Cells.ClearContents

With Sheets("Input")
.Columns(26).AutoFilter field:=1, Criteria1:="Y"
Range(.Cells(2, 26), .Cells(2, 26).End(xlDown)).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
Sheets("Failures").Cells(2, 1)
Range(.Cells(2, 26), .Cells(2, 26).End(xlDown)).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.Columns(26).AutoFilter
' Copy column headings from Sheet1 to Sheet2
.Rows("1:1").Copy Sheets("Failures").Cells(1, 1)

' Sorts failure data by krevs from smallest to largest
End With

With Sheets("Failures").Sort
.SortFields.Clear
.SortFields.Add Key:=Range( _
"AL2:AL100"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
.SetRange Range("A1:BA100")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
End Sub

jcfields
02-05-2009, 09:59 PM
Avoid looping and selection where possible. (snip...)

Thanks for the tip; newbie mistake :doh: I'm assuming unnecessary looping and selection make the macro slower than it might otherwise be...?

I'll give your tweaks a try. Thanks again. :beerchug:

Cheers,
Jeremy