Deleting Zeros and Shifting All Cells left

  • Thread starter Thread starter Bubba
  • Start date Start date
B

Bubba

I have a data set which is organized by rows. For each row I am calculating
the the number of zeros until I encounter the first None-Zero Cell. My data
set is all Numbers. I am using the formula:
=(MATCH(TRUE,INDEX(J5:FU5>0,0),0)-1)

40 40 40 40 20 20 20
12 12 12 12 6 6 6
0 0 0 0 40 40 40
2 2 2 2 0 0
0 0 0 0 0 40 40
0 0 0 0 0 0 40



I am copying this dataset into a new worksheet and now I want to remove
those zeros until my first non zero cell and shift those cells to the left so
my data would look like:

40 40 40 40 20 20 20
12 12 12 12 6 6 6
40 40 40
2 2 0 0 1 1 1
40 40
40

Does anyone know how to do this using formulas or a macro?
 
I don't understand how that 4th line:
2 2 2 2 0 0
gets converted to:
2 2 0 0 1 1 1

I'm guessing it was a typo.

If that's right, try this against a copy of your worksheet (it destroys the
original data when it runs).

Option Explicit
Sub testme()

Dim wks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim res As Long

Set wks = Worksheets("sheet1")

With wks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow
res = .Evaluate("MATCH(TRUE,INDEX(" _
& .Rows(iRow).Address & ">0,0),0)-1")
If res = 0 Then
'no zeros, skip this row
Else
.Cells(iRow, "A").Resize(1, res).Delete shift:=xlShiftToLeft
End If
Next iRow
End With

End Sub
 
Try this macro:

Sub ZeroKiller()
Dim r As Range, rKill As Range
Set rKill = Nothing
For Each r In ActiveSheet.UsedRange
If r.Value = 0 Then
If rKill Is Nothing Then
Set rKill = r
Else
Set rKill = Union(rKill, r)
End If
End If
Next
rKill.Delete shift:=xlToLeft
End Sub
 
This looks like it deletes all the 0's in the used range--including empty cells.

Although the sample results don't show a specific example, I don't think that's
what the OP really wanted:
 
Back
Top