Delete Column if all its values are equal to 0-CodePudding

I am new to VBA, and i would need some help in dealing with my data.

I want to delete the column if every value it contains are equal to zero

I have this so far:

Sub delete()
Dim FinalCol As Integer
FinalCol = Range("A1").End(xlToRight).Column
For i = FinalCol To 1 Step -1
    If Application.WorksheetFunction.Sum(Columns(i)) = 0 Then
    Columns(i).delete
    End If
Next i

End Sub

The problem is that in some columns the sum is equal to zero but they don't contain only zeros so I want to keep them.

Hope you guys can help me.

Thank you.

CodePudding user response：

Use CountIfs:

Sub delete()
   Dim FinalCol As Long
   FinalCol = Cells(1, Columns.Count).End(xlToLeft).Column

   Dim i As Long
   For i = FinalCol To 1 Step -1
       If WorksheetFunction.CountIfs(Columns(i), "<>0", Columns(i), "<>") = 0 Then
          Columns(i).delete
       End If
   Next i
End Sub

It is better to use Union and delete after looping, instead of deleting inside a loop:

Sub delete()
   Dim FinalCol As Long
   FinalCol = Cells(1, Columns.Count).End(xlToLeft).Column

   Dim i As Long
   For i = 1 to FinalCol
       If WorksheetFunction.CountIfs(Columns(i), "<>0", Columns(i), "<>") = 0 Then
          Dim ToDelete As Range
          If ToDelete Is Nothing Then
              Set ToDelete = Columns(i)
          Else
              Set ToDelete = Union(ToDelete, Columns(i))
          End If
      End If
   Next

   If Not ToDelete Is Nothing Then 
       ToDelete.Delete
   End If
End Sub

Another option is to use CountIfs and CountA:

If WorksheetFunction.CountIf(Columns(i), 0) = WorksheetFunction.CountA(Columns(i)) Then

The logic of these two options is:

If a column does not contain any non-zero elements, then delete it.
If the count of zeros = the count of non-blank elements in a column, then delete it.

CodePudding user response：

All Cells Containing Only the Number Zero

If all cells of a column of the range contain only the number 0 or a formula that evaluates to the number 0, it will delete the entire (worksheet) column.

Sub DeleteColumns()
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve
    
    Dim srg As Range, Data() As Variant, rCount As Long
    
    With ws.UsedRange
        rCount = .Rows.Count - 1 ' use -1 to exclude headers
        Set srg = .EntireColumn
        Data = .Resize(rCount).Offset(1)
    End With
    
    Dim urg As Range, crg As Range, r As Long, c As Long, ZeroFound As Boolean
    
    For c = 1 To UBound(Data, 2)
        For r = 1 To rCount
            ' Blank cells or cells containing '="0"' are not considered!
            If VarType(Data(r, c)) = vbDouble Then ' is a number
                If Data(r, c) = 0 Then ZeroFound = True
            End If
            If ZeroFound Then ZeroFound = False Else Exit For
        Next r
        If r > rCount Then
            Set crg = srg.Columns(c)
            If urg Is Nothing Then Set urg = crg Else Set urg = Union(urg, crg)
        End If
    Next c
            
    If Not urg Is Nothing Then urg.Delete
        
End Sub