Consolidating with empty-string ("") cells removed

[Thomas Toth]

Hi,

I'm trying to get a second table which contains all elements of each
column of the first one, except that the empty-string-output cells ("")
are removed, but one. The first table should remain, the second one can
be either calculated or copied in some way.

I have a formula in every cell which calculates a value. If the result
is not valid, the formula will output "" (empty string). Due to my data
structure there are many empty-string cells between two blocks of values
in each column. I would like to remove all of them, except one, such
that the two blocks are separated by one empty cell in each column.
Empty is ok, I don't need the values/formulas, it is the final output table.

My original table contains the names across, and alpha-numerical values
down the column, with possible "" from formulas inbetween. Like this:

Table1 (what I have):

Name1 Name2 Name3 Name4
E123 E2343 "" E3432
E354 "" "" F3437
N324 "" "" N54323
E634 "" "" ""
"" "" "" ""
"" "" "" ""
"" "" "" ""
I4325 N6377 N3245 G2307
E6543 E5233 "" N29374
N987 N4353 "" ""
G8377 "" "" ""
"" "" "" ""


Table2 (what I need):

Name1 Name2 Name3 Name4
E123 E2343 -- E3432
E354 -- N3245 F3437
N324 N6377 N54323
E634 E5233 --
-- N4353 G2307
I4325 N29374
E6543
N987
G8377

where -- represents a blank/empty cell.

I tried copying and pasting with removing blanks but that doesn't work
as they are considered non-empty because of the formulas, even if I tick
to only paste the values. Copy-paste with a filter won't work as there
isn't enough space left on the sheet, and it would become impractical to
use. Besides, I think I tried that too. VBA is not an option either.

Any ideas how I could get the second table?

Thanks for any help,

Thomas

 

[Dave Peterson]

So you're trying to make those duplicated cell look like ditto marks?

How about an alternative?

Keep the data and lose the ditto marks. But use format|conditional formatting
to make the duplicated cells look empty (white font on white fill, for example).

It'll make working with your data (sorting/filtering/charting/etc) much easier
if you keep the data.

If you want to try, visit Debra Dalgleish's site:
http://contextures.com/xlCondFormat03.html#Duplicate

 

[Thomas Toth]

So you're trying to make those duplicated cell look like ditto marks?

How about an alternative?

Keep the data and lose the ditto marks. But use format|conditional formatting
to make the duplicated cells look empty (white font on white fill, for example).

It'll make working with your data (sorting/filtering/charting/etc) much easier
if you keep the data.

If you want to try, visit Debra Dalgleish's site:
http://contextures.com/xlCondFormat03.html#Duplicate

Hi Dave,

well, not realy. I'm trying to make those multiple lines of dito marks
like a single empty cell. I don't care about the values and formulas in
table 2 as there is no further processing. Although I wouldn't mind if
it was a dynamic solution which I can somehow 'calculate' from table 1,
to save me having to copy them every time I use the tables.

So, speaking for column A, I would like to have only a one cell gap
between the values E634 and I4325, compared to 3 cells in table 1.

I don't have a problem with formating as an empty string, represented by
"", will not show in excel. I understand your solution but it will still
leave more than a 1 cell gap between the two blocks, even if they are blank.

Thanks for your help anyway,

Tom

 

[Dave Peterson]

So essentially, you're trying to compact each column--get rid of multiple
consecutive empty cells and replace them with a single empty cell?

This will work if the data is all values--no formulas. (Is that ok?)

Option Explicit
Sub testme01()
Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim DestCell As Range
Dim RngToCopy As Range
Dim myArea As Range
Dim myRng As Range
Dim myCol As Range

Set CurWks = ActiveSheet
Set NewWks = Worksheets.Add
Set DestCell = NewWks.Range("A1")

With CurWks

'remove the ""
.Cells.Replace What:=Chr(34) & Chr(34), Replacement:="", _
LookAt:=xlWhole, SearchOrder:=xlByRows, _
MatchCase:=False

For Each myCol In .UsedRange.Columns
Set myRng = Nothing
On Error Resume Next
Set myRng = myCol.Cells.SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If myRng Is Nothing Then
'do nothing!
Else
For Each myArea In myRng.Areas
With myArea
Set RngToCopy = .Resize(.Rows.Count + 1, 1)
End With

RngToCopy.Copy _
Destination:=DestCell

Set DestCell = DestCell.Offset(RngToCopy.Rows.Count)

Next myArea
End If

'get ready for next column
Set DestCell = NewWks.Cells(1, DestCell.Column + 1)
Next myCol
End With
End Sub

 

[Thomas Toth]

So essentially, you're trying to compact each column--get rid of multiple
consecutive empty cells and replace them with a single empty cell?

This will work if the data is all values--no formulas. (Is that ok?)

Option Explicit
Sub testme01()
Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim DestCell As Range
Dim RngToCopy As Range
Dim myArea As Range
Dim myRng As Range
Dim myCol As Range

Set CurWks = ActiveSheet
Set NewWks = Worksheets.Add
Set DestCell = NewWks.Range("A1")

With CurWks

'remove the ""
.Cells.Replace What:=Chr(34) & Chr(34), Replacement:="", _
LookAt:=xlWhole, SearchOrder:=xlByRows, _
MatchCase:=False

For Each myCol In .UsedRange.Columns
Set myRng = Nothing
On Error Resume Next
Set myRng = myCol.Cells.SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If myRng Is Nothing Then
'do nothing!
Else
For Each myArea In myRng.Areas
With myArea
Set RngToCopy = .Resize(.Rows.Count + 1, 1)
End With

RngToCopy.Copy _
Destination:=DestCell

Set DestCell = DestCell.Offset(RngToCopy.Rows.Count)

Next myArea
End If

'get ready for next column
Set DestCell = NewWks.Cells(1, DestCell.Column + 1)
Next myCol
End With
End Sub

Hi Dave,

yes, I'm trying to compact the columns. Unfortunately, formulas are a
must. Each cell contains something along the lines of

=IF(Sheet2!A1>0;Sheet3!A1;"")

and now I would like to compact the cells by removing duplicate cells
that don't show anything. Of course my formula is a bit more complicated
such that I can't do anything on that level. That's why I'm aming for a
second table as that one I hope to make dynamic (without VBA) so that
all I need to do in the end is recalculate my sheets.

Thanks for your help and patience,

Tom

 

[Dave Peterson]

If you want to do this just using formulas, then it's beyond me.

Maybe someone else will chime in.

You may want to double check this formula:

=IF(Sheet2!A1>0;Sheet3!A1;"")

did you mean to point at both Sheet2 and Sheet3?

===
Ps. You may have noticed that the microsoft.public.excel newsgroups are pretty
populated with mostly top-posters. (Yep, it's not the usenet standard.)


Thomas Toth wrote:

 

[Thomas Toth]

Hi Dave,

thanks a lot for your help anyway. I mean VBA would be great too, I just
don't know much myself.

The formula I gave is a short form of what I have. Mine contains several
ifs, conditions, logic, etc. But I don't know it by heart yet and I
don't have it with me. I just wanted to indicate the output value which
is in the blank cells. But I use something similar as I'm pulling
numbers from several sheets into one.

I just noticed the top-posting myself, sorry for the inconvenience. I
usually read the post online and then answered using T-bird and didn't
pay attention to this detail. Just started writing.

Cheers,

Tom

 

[Dave Peterson]

If the original sheet has formulas, the you could use the code but you have to
do some work first.

Copy the original sheet
select all the cells on that new sheet
edit|copy, Edit|paste special|values
then run the macro you have.

You could use this modified version:

Option Explicit
Sub testme01()
Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim DestCell As Range
Dim RngToCopy As Range
Dim myArea As Range
Dim myRng As Range
Dim myCol As Range

Activesheet.copy 'copies to a new workbook
Set CurWks = ActiveSheet
'convert to values
curwks.cells.copy _
destination:=curwks.cells

'create a new worksheet in a new workbook for the output
Set NewWks = Workbooks.add(1).worksheets(1)
Set DestCell = NewWks.Range("A1")

With CurWks

'remove the ""
.Cells.Replace What:=Chr(34) & Chr(34), Replacement:="", _
LookAt:=xlWhole, SearchOrder:=xlByRows, _
MatchCase:=False

For Each myCol In .UsedRange.Columns
Set myRng = Nothing
On Error Resume Next
Set myRng = myCol.Cells.SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If myRng Is Nothing Then
'do nothing!
Else
For Each myArea In myRng.Areas
With myArea
Set RngToCopy = .Resize(.Rows.Count + 1, 1)
End With

RngToCopy.Copy _
Destination:=DestCell

Set DestCell = DestCell.Offset(RngToCopy.Rows.Count)

Next myArea
End If

'get ready for next column
Set DestCell = NewWks.Cells(1, DestCell.Column + 1)
Next myCol
End With

'clean up that helper worksheet/workbook.
curwks.parent.close savechanges:=false
End Sub