filling in blank cells with "0" upon condition macro

**ad9051** · 07-06-2011, 07:57 AM

Hello and many thanks for taking a look at my problem. I have enclosed an example spreadsheet to make describing it easier. Essentially i need a macro that looks in column b, if this ="x" and any cell from that row is blank then input a zero. And to do this until there is no more data in column A.

Many thanks

Alan

**Marcol** · 07-06-2011, 08:53 AM

Is this what you are after?

In the Sheet Module Change Event

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim FirstRow As Long, LastRow As Long
    Dim FirstCol As Long, LastCol As Long, ColNo As Long
    Dim ForZeroUse
    Dim isect As Range
    Dim ws As Worksheet

    On Error GoTo ResetApplication
    Application.EnableEvents = False

    Set ws = ActiveSheet
    With ws
        FirstRow = .UsedRange.Row
        LastRow = .UsedRange.Row + .UsedRange.Rows.Count - 1

        FirstCol = .UsedRange.Column
        LastCol = .UsedRange.Column + .UsedRange.Columns.Count - 1

        Set isect = Intersect(Target, .Range(.Cells(FirstRow, FirstCol), .Cells(LastRow, LastCol)))

        If Not isect Is Nothing Then
            If Cells(Target.Row, FirstCol + 1) = "x" Then
                ForZeroUse = 0
            Else
                ForZeroUse = ""
            End If
            For ColNo = FirstCol + 4 To LastCol
                If Cells(Target.Row, ColNo) <= 0 Then Cells(Target.Row, ColNo) = ForZeroUse
            Next
        End If
    End With

ResetApplication:
    Err.Clear
    On Error GoTo 0
    Application.EnableEvents = True
    Set isect = Nothing
End Sub

Try changing or deleting "x" or "y" in Column B.

Hope this helps.

**watersev** · 07-06-2011, 10:06 AM

hi, ad9051, please check attachment, run code "test"

**tigeravatar** · 07-06-2011, 11:41 AM

Alan,

Throwing in my two cents:

Sub ZeroFillerMacro_for_ad9051()
    
    ActiveSheet.UsedRange.AutoFilter 2, "x"
    ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Replace vbNullString, 0
    ActiveSheet.UsedRange.AutoFilter
    
End Sub

Hope that helps,
~tigeravatar

**Hyflex** · 07-06-2011, 01:33 PM

Something I threw together too, just note there may be mistakes because I'm pretty new to vba but I think this is ok, it works in my test version, spesific to the range of cells you were looking for.

Sub Zeroify()
    
    'Turn Optimizations On'
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    'Dim List'
    Dim rcdCell As Range
      
    'Set List'
                'Define the Sheet, Define row range'
    Set rRange = Sheets("Sheet1").Range([A1], Cells(Rows.Count, "A").End(xlUp))
    
    'For each row in row range
    For Each rCell In rRange

        'For each column in row offset from 4 in a loop to column 16 from row range'
        For cRange = 4 To 16

            'Set List'
            'Set Offset of 1 to the right from row cell where we will find the x'
            Set xCell = rCell.Offset(0, 1)
            'Set offset to a looped column range on row and if x exists'
            Set r0Cell = rCell.Offset(0, cRange)

                'If cell has x then if column range has a blank value then new value is 0'
                If xCell.Value = "x" Then If r0Cell.Value = "" Then r0Cell.Value = "0"

        'Next Column'
        Next cRange

    'Next Row'
    Next rCell
    
    'Turn Optimizations Off'
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
End Sub

**ad9051** · 07-06-2011, 09:17 PM

Amazing guys, you guys are like buses! Sometimes u wait for a long time for one, then 10 come at once (or in this case) 4. Hyflex yours seems to be the most appropriate. But thanks to all the others that posted, i will amend your reputation as such!

All the best

Alan