Skip copying empty column where remaining rows are filled

[KeriM]

I have some code that looks for a header value and copies the column i
a header value is found and pastes it on a new sheet. It's set up t
copy non-contiguous data, so if it finds a blank cell in the data i
does an xlUp to make sure it copies the entire data set.

Unfortunately, this means it still copies the column if the column i
completely blank except for the header value. How can I prevent thi
from happening?


Code
-------------------


For Each cell In headerRow
Select Case cell.Value
Case "Value 1", "Value 2", "Value 3"

Set bottom = Cells(Cells.SpecialCells(xlCellTypeLastCell).Row, _
cell.Column)
If bottom.Value <> "" Then
Range(cell.Offset(1, 0).Address & ":" & bottom.Address).Copy
Else
Range(cell.Offset(1, 0).Address & ":" & Cells(bottom.End(xlUp).Row, _
cell.Column).Address).Copy


-------------------


So if Value 3 is blank except for the header row. It will paste "Valu
3" instead of skipping that column. I trid to put a cells.count befor
that Else statement, to say if the cell count = 1 skip it, but i
resulted in an overflow error. Any help is appreciated

 

[Claus Busch]

Hi,

Am Mon, 8 Oct 2012 16:25:43 +0000 schrieb KeriM:

Unfortunately, this means it still copies the column if the column is
completely blank except for the header value. How can I prevent this
from happening?

try:
For Each rngC In headerrow
Select Case rngC.Value
Case "Value 1", "Value 2", "Value 3"
If WorksheetFunction.CountA(Columns(rngC.Column)) > 1 Then
LRow = Cells(Rows.Count, rngC.Column).End(xlUp).Row
Range(Cells(1, rngC.Column), _
Cells(LRow, rngC.Column)).Copy



Regards
Claus Busch

 

[Claus Busch]

Hi,

or try:
For Each rngC In headerrow
Select Case rngC.Value
Case "Value 1", "Value 2", "Value 3"
LRow = Cells(Rows.Count, rngC.Column).End(xlUp).Row
If LRow > 1 Then
Range(Cells(1, rngC.Column), _
Cells(LRow, rngC.Column)).Copy


Regards
Claus Busch