ExcelBanter - Skip copying empty column where remaining rows are filled

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - Skip copying empty column where remaining rows are filled (https://www.excelbanter.com/excel-programming/447317-skip-copying-empty-column-where-remaining-rows-filled.html)

Skip copying empty column where remaining rows are filled

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

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?

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 "Value 3" instead of skipping that column. I trid to put a cells.count before that Else statement, to say if the cell count = 1 skip it, but it resulted in an overflow error. Any help is appreciated!

Quote:

Originally Posted by KeriM (Post 1606170)

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

Nevermind, I figured it out. I needed to do a "Counta" before the else. Now it skips to the next column header.

NumberofCells = Application.CountA(cell)
If NumberofCells = 1 Then GoTo Skip

Skip copying empty column where remaining rows are filled

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
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Skip copying empty column where remaining rows are filled

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
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2