Need to copy column results while hiding empty cells

[Huck321]

I have a column(for example: b1:b5000) that has cells that have info, and many other cells in that column that are empty. I have copied that column to another worksheet. On the new worksheet, I need to leave the order of the cells with info in the same order, but remove all of the empty cells in between. Also, when I change certain variables, some of the empty cells on the original worksheet will then have info, and some cells that had info will then be empty. So, every time I change a variable, I would like the list that excludes/hides empty cells to automatically readjust to the changes.

Here is an example:

B1 has a value of 6. B2 is empty. B3 has a value of 2. I want the value of B1 to be immediately followed by B3, leaving out empty cell B2. If B2 eventually has data, then I would like it to UNHIDE B2. So, then it would be B1 followed by B2 and then B3 (assuming b1 and b2 still have info in them as well).

Is there a simple way to do this with a formula or array? Thanks.

 

[crimson_b1ade]

I only know how to do that using vba (see below code). Hold down Alt + F11 and VBA will open, in the project explorer, insert a VBA module (on Tool bar click Insert then Module) (that's only if a module isn't already there). Then paste the below code into the vba module.


Sub TakeMeToYourLeader()

Application.ScreenUpdating = False

Sheets("Sheet1").Activate

myRng = Application.WorksheetFunction.CountA(Range("B:B"))

j = 1

For i = 1 To myRng

If Application.WorksheetFunction.IsNumber(Range("B" & i).Value) = True Then

Rows(i).Select
Selection.Copy

Sheets("Sheet2").Activate
Rows(j).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("Sheet1").Activate
Rows(i).EntireRow.Hidden = False
Application.CutCopyMode = False

j = j + 1
Else
Sheets("Sheet1").Activate
Rows(i).EntireRow.Hidden = True

End If

Next i

End Sub

 

[jindon]

try

Sub test()
Range("b1:b5000").Copy
Range("d1").PasteSpecial xlPasteValues
On Error Resume Next
Range("d1", Range("d" & Rows.Count).End(xlUp)).SpecialCells(4).Delete xlShiftUp
End Sub

 

[Huck321]

I tried your code but found the numbers copied to column "d" were not shifted up until after I highlighted what looked to be empty cells(there is no formula in them or any numbers) and hit the delete key, as you would do if there were actual visible formula or data in them.

So, is there something invisible that is there? And what do I need to change in my original formula to make the empty cells truly empty.

What ends up in column "d" comes from column "B", and the values from column B originate from column A (cell B1 has the code: "=A1" , B2 has "=A2" etc.)

A1 has this formula:
=if(f1>g1,6,"")

So, lets say for A1 the result is blank/empty(""), B1 will also appear empty. BUT, even after I run your code, and even though it pastes the B column data over to the d column, the d column will remain identical to the b column instead of shifting column d data upward. The only way to get the code to work is to manually click into the cells that appear empty in B1 and hit the delete key, which of course gives the same empty look as before I hit delete, yet this time when i run the code the d column data does shift upward as desired.

I have a feeling "" (double quotations) is the problem and does not really leave the cell empty.

Any ideas?

 

[jindon]

try

Sub test()
Range("b1:b5000").Copy
With Range("d1:d5000")
    .PasteSpecial xlPasteValues
    .Value = Evaluate("if(" & .address & "<>""""," & .address & ",na())")
    On Error Resume Next
    .SpecialCells(2,16).Delete xlShiftUp
End With
End Sub

 

[Huck321]

Just about there. Everything in column d now shifts up.

Is there anyway to make your code run automatically when anything in column B changes.

Example: B1 is empty. I change a variable that affects the result for a1 and therefore, which also changes b1 to reflect this new value(example: b1 is no longer empty but has a value of, say, "6"). This changing of value for B1 triggers the running of your code and updates column d to include the new change automatically.

 

[jindon]

To a sheet module

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("b1:b5000")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Range("b1:b5000").Copy
With Range("d1:d5000")
    .PasteSpecial xlPasteValues
    .Value = Evaluate("if(" & .address & "<>""""," & .address & ",na())")
    On Error Resume Next
    .SpecialCells(2,16).Delete xlShiftUp
End With
Application.EnableEvents = True
End Sub