CODEWITHSUNDEEP
excelvba
Josh Ng
Josh Ng

Reputation: 198

For every blank cell in column, run an auto fill macro

enter image description here

To this:

enter image description here

I would like the set of code to be able to pick up every blank in column C and perform a macro in it. It would have been easy if my sheet has a fixed range, however, my list is constantly increasing in rows... Hence, I would need the macro to be able to run macro on blank cells and skip on those filled cells. The macro should also end upon the last filled cell in the column. 

 Sub Testing()

Dim Rl As Long                      ' last row
Dim Tmp As Variant
Dim R As Long                       ' row counter

With ThisWorkbook.ActiveSheet       ' modify to suit
    Rl = .Cells(.Rows.Count, "C").End(xlUp).Row
    ' work on column C
    For R = 1 To Rl                 ' start the loop in row 1
        Tmp = .Cells(R, "C").Value
        If Len(Tmp) Then
            Cells(R, "C").Select
            Call AutoFill
        End If
    Next R
End With


Sub AutoFill()
Application.EnableEvents = False
    Dim rng As Range
    Set rng = Range(Selection, Selection.End(xlDown))
    Set rng = rng.Resize(rng.Rows.Count - 1, rng.Columns.Count)
    rng.FillDown

End Sub

Upvotes: 1

Views: 575

Answers (1)

JvdV
JvdV

Reputation: 75870

Your problem is here: If Len(Tmp) Then and that's just checking if Tmp has any length. So this actually ignores your empty cells by skipping them. Instead you are selecting cells with values in them.

Do not loop all cells in a range. Instead just look at those empty cells of interest. For example:

Sub Testing()

Dim LR As Long, LC as Long
Dim rng As Range
Dim ws As Worksheet

Set ws = ThisWorkbook.Worksheets("Sheet1")
With ws
    LR = .Cells(.Rows.Count, "A").End(xlUp).Row
    LC = .Cells(LR, .Columns.Count).End(xlToLeft).Column
    Set rng = .Range(.Cells(1, 1), .Cells(LR, LC))
    If WorksheetFunction.CountBlank(rng) > 0 Then
        For Each area In rng.SpecialCells(xlCellTypeBlanks).Areas
            area.Offset(-1).Resize(area.Rows.Count + 1).FillDown
        Next
    End If
End With

End Sub

As you can see I left out .Select and ActiveSheet as that's poor coding and usually not needed at all.

Upvotes: 3

Related Questions