Deleting blank cells globally

[MrHanky]

Hi, I have a 20x20 matrix of either non-zero values or "blanks" ("") that are
not constants--these cells have formulas.

I'd appreciate some assistance creating a macro that will systematically
traverse the matrix and delete cells (moving remaining cells up) that have
either a blank or some other non-number value.

The result should be 20 columns starting at, say, row 0, where each column
has up to 20 numbers, in original sequence, minus "blanks".

It could be done in-place if possible or somewhere else in the workbook.
Thanks in advance for the help

 

[Sheeloo]

Try the macro below...
It assumes your data starts at A1... i.e. Cells(i,j) with i=1, k=1
it writes out the values at A25 i.e. Cells(l,k) with l=25, k=1
You may change these values as per your requirment
It works on the activesheet

Sub deleteBlanks()
With ActiveSheet
l = 25
K = 1
For i = 1 To 20
For j = 1 To 20
If .Cells(i, j) <> "" Then
.Cells(l, K) = .Cells(i, j)
If K = 20 Then
K = 1
l = l + 1
Else
K = K + 1
End If
End If
Next j
Next i
End With
End Sub

 

[Sheeloo]

Try the macro below...
It assumes your data starts at A1... i.e. Cells(i,j) with i=1, k=1
it writes out the values at A25 i.e. Cells(l,k) with l=25, k=1
You may change these values as per your requirment
It works on the activesheet

Sub deleteBlanks()
With ActiveSheet
l = 25
K = 1
For i = 1 To 20
For j = 1 To 20
If .Cells(i, j) <> "" Then
.Cells(l, K) = .Cells(i, j)
If K = 20 Then
K = 1
l = l + 1
Else
K = K + 1
End If
End If
Next j
Next i
End With
End Sub

 

[Sheeloo]

Suggested macro will only remove blanks.
You can use ISNUMBER to adapt it to your needs.
Let me know if you want me to do that.

 

[Sheeloo]

Suggested macro will only remove blanks.
You can use ISNUMBER to adapt it to your needs.
Let me know if you want me to do that.

 

[Sheeloo]

Try
Sub deleteBlanks()
With ActiveSheet
l = 25
K = 1
For i = 1 To 20
For j = 1 To 20
If IsNumeric(.Cells(i, j)) And .Cells(i, j) <> 0 Then
.Cells(l, K) = .Cells(i, j)
If K = 20 Then
K = 1
l = l + 1
Else
K = K + 1
End If
End If
Next j
Next i
End With
End Sub

 

[Sheeloo]

Try
Sub deleteBlanks()
With ActiveSheet
l = 25
K = 1
For i = 1 To 20
For j = 1 To 20
If IsNumeric(.Cells(i, j)) And .Cells(i, j) <> 0 Then
.Cells(l, K) = .Cells(i, j)
If K = 20 Then
K = 1
l = l + 1
Else
K = K + 1
End If
End If
Next j
Next i
End With
End Sub

 

[Gord Dibben]

Sheeloo

Probably not applicable in this particular instance but just for
info........

Before using isnumeric see this thread.

You could be surprised.

http://tinyurl.com/9to4ka


Gord Dibben MS Excel MVP

 

[Gord Dibben]

Sheeloo

Probably not applicable in this particular instance but just for
info........

Before using isnumeric see this thread.

You could be surprised.

http://tinyurl.com/9to4ka


Gord Dibben MS Excel MVP