Removing blanks from data set populated with formulas

[kishdaba]

Hi, can you help please?

I have a data set that is populated with data from a set of formulas. There are multiple rows and multiple columns. The data set contains blank cells where the formula returns no results.

What i want to do is to create a single list in one column that will be the result of taking each populated cell and appending it to the end of that list.

An example would be (note, you wouldn't see the formula as the result is blank but am showing for illustration):

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Workboots[/TD]
[TD]Tree[/TD]
[TD]=If(A=B,"XYZ","")[/TD]
[/TR]
[TR]
[TD]=If(A=C,"XYZ","")[/TD]
[TD]Banana[/TD]
[TD]Fox[/TD]
[/TR]
[TR]
[TD]=If(A=D,"XYZ","")[/TD]
[TD]Shoe[/TD]
[TD]Dog[/TD]
[/TR]
</tbody>[/TABLE]

The result I need is the data lined up in a single column with the blanks removed:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Workboots[/TD]
[/TR]
[TR]
[TD]Tree[/TD]
[/TR]
[TR]
[TD]Banana[/TD]
[/TR]
[TR]
[TD]Fox[/TD]
[/TR]
[TR]
[TD]Shoe[/TD]
[/TR]
[TR]
[TD]Dog[/TD]
[/TR]
</tbody>[/TABLE]


Thanks for your help!

 

[Fluff]

Hi & welcome to MrExcel.
Maybe something like

Sub kishaba()
   Dim Cl As Range
   For Each Cl In Range("A1").CurrentRegion
      If Cl.Value <> "" Then Range("[COLOR=#ff0000]X[/COLOR]" & Rows.Count).End(xlUp).Offset(1).Value = Cl.Value
   Next Cl
End Sub

Channge the value in red to the column where you want the output

 

[DanteAmor]

Try this

Change "D" to the column you want to review

Sub Removing_Blanks()
  Dim sh As Worksheet, r As Long, col As String
  Application.ScreenUpdating = False
  Set sh = ActiveSheet
  col = [COLOR=#ff0000]"[B]D[/B]"[/COLOR]
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
  r = sh.Range(col & 1).End(xlDown).Row
  sh.Range(col & "1:" & col & r).AutoFilter Field:=1, Criteria1:="<>"
  sh.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Copy
  sh.Range(col & r + 3).PasteSpecial xlPasteValues
  sh.ShowAllData
  Application.CutCopyMode = False
End Sub