Merge cells if value is zero

[sandman007]

Hello!
I´have a problem with merging several textcell together. In one kolumn i
have textcells and in another column numbers. I´d like excel to merge the
textcells together if the row have number zero. The merge text should also be
on different rows.
A B
1 Cars 1
2 Dogs 0
3 Cats 1
4 Candy 0
5 icecream 0

New cell in a diffrent worksheet:
Dogs
Candy
icecream

Can i copy this makro or formula in an easy way even if the cellreference is
different.

thank you so much for your help/ Johan

 

[Dan R.]

So basically you want to delete the rows where column B is not 0?

 

[sandman007]

Yes, that is correct, that is a much simplier way of explaining it , haven´t
thought about it in that direction before.

/Johan



"Dan R." skrev:

 

[Dave Peterson]

Maybe you could select column B
Data|Filter|autofilter
show the rows where column B equals 0
delete those visible cells
(Or copy those visible cells to a new worksheet????)

You may just want to filter values that are not equal to 0.

The data will still be there--just in case you need it.

 

[sandman007]

Yes, that should work but i still like to merge the text to only one cell,
with new row for every textcell. Another problem, will this filter work if
you have several columns with numbers and every column should have there own
list with text.
A B C D E etc.
1 Cars 1 0 1
2 Dogs 0 1 1
3 Cats 1 0 0
4 Candy 0 0 1
5 icecream 0 0 0

New cell 1:
Dogs
Candy
Icecream

New cell 2:
Cars
Cats
Candy
Icecream

etc. etc.

/Johan

"Dave Peterson" skrev:

 

[Dave Peterson]

This may work for you:

Option Explicit
Sub testme()
Dim CurWks As Worksheet
Dim RptWks As Worksheet
Dim iRow As Long
Dim iCol As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim oRow As Long
Dim myStr As String

Set CurWks = Worksheets("Sheet1")
Set RptWks = Worksheets.Add

oRow = 0
With CurWks
FirstRow = 1 'no headers
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
FirstCol = 2 'items in column A
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

For iCol = FirstCol To LastCol
myStr = ""
If Application.CountIf(.Range(.Cells(FirstRow, iCol), _
.Cells(LastRow, iCol)), 0) = 0 Then
'no zeros in that column, skip it
Else
oRow = oRow + 1
For iRow = FirstRow To LastRow
If .Cells(iRow, iCol).Value = 0 Then
'vblf is the same as alt-enter
myStr = myStr & .Cells(iRow, "A").Value & vbLf
End If
Next iRow
RptWks.Cells(oRow, "A").Value = Left(myStr, Len(myStr) - 1)
End If
Next iCol
End With

With RptWks.UsedRange
.WrapText = True
.Columns.AutoFit
End With

End Sub

Yes, that should work but i still like to merge the text to only one cell,
with new row for every textcell. Another problem, will this filter work if
you have several columns with numbers and every column should have there own
list with text.
A B C D E etc.
1 Cars 1 0 1
2 Dogs 0 1 1
3 Cats 1 0 0
4 Candy 0 0 1
5 icecream 0 0 0

New cell 1:
Dogs
Candy
Icecream

New cell 2:
Cars
Cats
Candy
Icecream

etc. etc.

/Johan

"Dave Peterson" skrev: