remove blank rows

[scolbert]

I've got a workbook where I'm using code to copy rows of data from one sheet
to a recap sheet if a condition is met (all rows with "Y" in one column).
The data is being copied to sheet two, but blank rows are being left in
between rows where the "Y" condition is not met. My current code is:
'have x start at row 2
x = 2

'loop until a blank row is found
Do While Sheets("Jan 09").Cells(x, 1).Value <> ""

If Sheets("Jan 09").Cells(x, 11).Value = "Y" Then
'this will put the value of column 1 "Payable To" in the recap
sheet
Sheets("2009 Recap").Select
Cells(x, 1).Value = Sheets("Jan 09").Cells(x, 1)
End If

'increase the value of x by 1 to act on the next row
x = x + 1

Loop

all assistance is appreciated!

 

[dbKemp]

I've got a workbook where I'm using code to copy rows of data from one sheet
to a recap sheet if a condition is met (all rows with "Y" in one column).
The data is being copied to sheet two, but blank rows are being left in
between rows where the "Y" condition is not met. My current code is:
'have x start at row 2
x = 2

'loop until a blank row is found
Do While Sheets("Jan 09").Cells(x, 1).Value <> ""

If Sheets("Jan 09").Cells(x, 11).Value = "Y" Then
'this will put the value of column 1 "Payable To" in the recap
sheet
Sheets("2009 Recap").Select
Cells(x, 1).Value = Sheets("Jan 09").Cells(x, 1)
End If

'increase the value of x by 1 to act on the next row
x = x + 1

Loop

all assistance is appreciated!

You need a separate counter for Recap sheet that only gets incremented
if Jan 09 cell value is Y.

 

[scolbert]

Thanks for your time - can you provide a code example and where to enter it
(I'm fairly new at this).

 

[Rick Rothstein]

Below is a macro that uses a completely different approach than your code
which should do what you want. The only places sheet names and cell
references are located is in the With statement and in the very last
statement... these are the only ones you might have to change. I noted, by
the way, that your description said you were copying rows of data but your
code only copies Column A cells... my code copies the entire row as per your
description's intent... if this is incorrect, then just remove the
..EntireRow property from the last statement.

Sub CopyRowsWithYs()
Dim FirstAddress As String
Dim FoundCells As Range
Dim CellWithYsInThem As Range
With Worksheets("Jan 09").Range("K:K")
Set CellWithYsInThem = .Find("Y", MatchCase:=False, LookAt:=xlWhole)
If Not CellWithYsInThem Is Nothing Then
FirstAddress = CellWithYsInThem.Address
Set FoundCells = CellWithYsInThem
Do
Set FoundCells = Union(FoundCells, CellWithYsInThem)
Set CellWithYsInThem = .FindNext(CellWithYsInThem)
Loop While Not CellWithYsInThem Is Nothing And _
CellWithYsInThem.Address <> FirstAddress
End If
End With
FoundCells.EntireRow.Copy Worksheets("2009 Recap").Range("A1")
End Sub

 

[Rick Rothstein]

I should point out there are some restrictions for the method I employed in
my macro, but I don't think they will be triggered given how I think your
worksheet will function. The Union method will not work if there are more
than 8000+ non-contiguous areas in it (I doubt if you will have anywhere
near that many rows with a Y in Column K). Also, things will start to slow
down noticeably if there are more than 100 to 150 non-contiguous areas in
the union. If that could be the case (more than 100 to 150 rows with a Y in
Column K), then let me know and I'll modify the code to work more
efficiently around that situation.

 

[scolbert]

Rick,
Thank you for your assistance - you are correct in stating that I do not
have that many non-continguous areas, so the code works great!