VBA Fill out all cells between two cells

Question

I am currently trying to write some VBA code which will fill out all cells between two cells with the value of the two cells.

Here is what I have :

And I would like the code to fill out all cells in between like this:

So, as you can see I would like all the cells in between to be filled out with the same value as the two corner cells.

Any help is very much appreciated! Thanks in advance.

Loop through your rows. Inside that loop, loop through your columns. If cell value is not blank, set a variable equal to cell value and write it to following cells, checking if they are empty. If not empty, exit inner loop. — CMArg, Mar 17 '17 at 11:57
Comment update: before looping through cells in a row, check if there is anything in that row (I see you have empty rows). Look [here](http://stackoverflow.com/a/3628123/1726522) (the first short piece of code). — CMArg, Mar 17 '17 at 12:15
I know it's not tagged as formula, just for interest it would be possible to fill in the spaces in another sheet using a formula. — Tom Sharpe, Mar 17 '17 at 12:41

score 5 · Answer 1 · answered Mar 17 '17 at 12:14

5

you could use SpecialCells() method of Range object:

Sub main()
    Dim cell As Range

    For Each cell In Intersect(Columns(1), ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants).EntireRow)
        With cell.EntireRow.SpecialCells(xlCellTypeConstants)
            Range(.Areas(1), .Areas(2)).Value = .Areas(1).Value
        End With
    Next
End Sub

answered Mar 17 '17 at 12:14

user3598756

28,893
4
18
28

OMG! I'm curious: if there were three characters in a row, can ranges be refered as `.Areas(1)`, `.Areas(2)` and `.Areas(3)`? I think a couple of short comments in your code would be fantastic for amateurs like me... – CMArg Mar 17 '17 at 12:27
1

If each character were in not contiguous cells then you would actually catch the ith one with .Areas(i). – user3598756 Mar 17 '17 at 12:30
Thanks a lot! I'm impressed, really. – CMArg Mar 17 '17 at 12:35
@user3598756 : Nicely done, as always! ;) I went in all loops blazing!^^ – R3uK Mar 17 '17 at 12:54
@R3uK, thanks. Seems like loops catch more the eye though...;-) – user3598756 Mar 17 '17 at 12:57
@user3598756 : Yeah apparently it is! Dunno why the OP choose it, maybe to help the little guy!^^ – R3uK Mar 17 '17 at 13:16

score 2 · Accepted Answer · edited Sep 21 '17 at 16:23

Place this in a new module and run test_DTodor:

Option Explicit

Sub test_DTodor()
    Dim wS As Worksheet
    Dim LastRow As Double
    Dim LastCol As Double
    Dim i As Double
    Dim j As Double
    Dim k As Double
    Dim RowVal As String

    Set wS = ThisWorkbook.Sheets("Sheet1")
    LastRow = LastRow_1(wS)
    LastCol = LastCol_1(wS)

    For i = 1 To LastRow
        For j = 1 To LastCol
            With wS
                If .Cells(i, j) <> vbNullString Then
                    '1st value of the row found
                    RowVal = .Cells(i, j).Value
                    k = 1
                    'Fill until next value of that row
                    Do While j + k <= LastCol And .Cells(i, j + k) = vbNullString
                        .Cells(i, j + k).Value = RowVal
                        k = k + 1
                    Loop
                    'Go to next row
                    Exit For
                Else
                End If
            End With 'wS
        Next j
    Next i
End Sub

Public Function LastCol_1(wS As Worksheet) As Double
    With wS
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            LastCol_1 = .Cells.Find(What:="*", _
                                After:=.Range("A1"), _
                                Lookat:=xlPart, _
                                LookIn:=xlFormulas, _
                                SearchOrder:=xlByColumns, _
                                SearchDirection:=xlPrevious, _
                                MatchCase:=False).Column
        Else
            LastCol_1 = 1
        End If
    End With
End Function

Public Function LastRow_1(wS As Worksheet) As Double
    With wS
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            LastRow_1 = .Cells.Find(What:="*", _
                                After:=.Range("A1"), _
                                Lookat:=xlPart, _
                                LookIn:=xlFormulas, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious, _
                                MatchCase:=False).Row
        Else
            LastRow_1 = 1
        End If
    End With
End Function

I give +1 for this because it doesn't fall over in the special (possibly trivial!) case where the characters follow one another. — Tom Sharpe, Mar 17 '17 at 12:52
@R3uK The code works pretty well so far only problem that I have is that if I call this module, let it work and then let that module call another module which copies all the cells into another worksheet for some reason the columns which got filled up by your module don't get copied. It looks like the module hasn't even worked. But if I let it stop after your module is done and then manually (through Macro browser Alt + F8) start the next module which copies everything into another worksheet it works. — D. Todor, Mar 17 '17 at 14:44

VBA Fill out all cells between two cells

2 Answers2

Linked