Excel - VBA fill in cells between 1st and Last val

Question

I am attempting to use VBA to fill all blank cells in rows with the value to the left, with the exception that I only want to fill the blank cells between the first and last value in the row (not including row 1 and column A, which are identifiers).

I've struggled with getting the loop to stop once the last column with a value has been reached (as this changes with each row), rather than running all the way through the last column on the sheet.

Originally this was marked as duplicate (Autofill when there are blank values), but this does not solve the mentioned problem. This continues until the sheet ends. As seen in the picture below, the fill should stop when the last value is reached.

I am searching for a solution that will allow me to do this for an entire sheet at once, even though the data ends in different columns throughout the sheet. There are 1000+ rows, so running for each row could be quite tedious.

I've been using this code to fill the data (excluding the 1st row and column). But this is where I am not sure how to get it to stop at the last value in the row.

Sub test()
With ThisWorkbook.Sheets("Sheet1").Range("A:A")
    With Range(.Cells(2, 2), .Cells(.Rows.Count, 36).End(xlUp))
        With .Offset(0, 1)
            .Value = .Value
            On Error Resume Next
            .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]&"""""
            On Error GoTo 0
            .Value = .Value
        End With
    End With
End With
End Sub

If my explanation was not clear, This is a sample and the output I am trying to create

Thank you all so much in advance for all your help!

Answer 1

And here is yet another solution (just to give you some variety):

Option Explicit

Sub fillInTheBlanks()

Dim lngRow As Long
Dim ws As Worksheet
Dim lngColumn As Long
Dim bolStart As Boolean
Dim lngLastColumn As Long
Dim dblTempValue As Double
Dim arrSheetCopy As Variant

Set ws = ThisWorkbook.Worksheets("Sheet1")
arrSheetCopy = ws.Range(ws.Cells(3, 1), ws.Cells(ws.Cells(ws.Rows.Count, "A").End(xlUp).Row, ws.UsedRange.Columns.Count)).Value2

For lngRow = LBound(arrSheetCopy, 1) To UBound(arrSheetCopy, 1)
    bolStart = False
    lngLastColumn = 0
    For lngColumn = LBound(arrSheetCopy, 2) To UBound(arrSheetCopy, 2)
        If Not arrSheetCopy(lngRow, lngColumn) = vbEmpty Then lngLastColumn = lngColumn
    Next lngColumn
    For lngColumn = LBound(arrSheetCopy, 2) To lngLastColumn
        If arrSheetCopy(lngRow, lngColumn) = vbEmpty And bolStart Then
            arrSheetCopy(lngRow, lngColumn) = dblTempValue
        Else
            If Not arrSheetCopy(lngRow, lngColumn) = vbEmpty And IsNumeric(arrSheetCopy(lngRow, lngColumn)) Then
                bolStart = True
                dblTempValue = CDbl(arrSheetCopy(lngRow, lngColumn))
            End If
        End If
    Next lngColumn
Next lngRow

ws.Range("A3").Resize(UBound(arrSheetCopy, 1), UBound(arrSheetCopy, 2)).Value2 = arrSheetCopy

End Sub

This one is probably the fastest solution (even though it seems a bit bulky with much more lines of code when compared to the other solutions). That's due to the fact that this solution is doing most of the work in memory and not on the sheet. The entire sheet is loaded into a variable and then the work is done on the variable before the result (the variable) is written back to the sheet. So, if you have a speed problem then you might want to consider using this solution.

Answer 2

You may try something like this...

Sub FillBlanks()
Dim r As Long, lr As Long, lc As Long
Dim cell As Range, FirstCell As Range, LastCell As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(2, Columns.Count).End(xlToLeft).Column
For r = 3 To lr
    Set FirstCell = Range(Cells(r, 1), Cells(r, lc)).Find(what:="*", after:=Cells(r, 1))
    If Not FirstCell Is Nothing And FirstCell.Column > 1 Then
        Set LastCell = Cells(r, Columns.Count).End(xlToLeft)
        Range(FirstCell, LastCell).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]"
        Range(FirstCell, LastCell).Value = Range(FirstCell, LastCell).Value
    End If
Next r
End Sub

Answer 3

Here is one possible that meets your sample data's expectations.

Sub wqewqwew()
    Dim i As Long, fc As Variant, lc As Long

    'necessary if you do not want to confirm numbers and blanks in any row
    On Error Resume Next

    With ThisWorkbook.Worksheets("Sheet6")
        For i = 3 To .Cells(.Rows.Count, "A").End(xlUp).Row
            If CBool(Application.Count(Rows(i))) Then
                fc = Intersect(.Rows(i), .UsedRange).Offset(0, 1).SpecialCells(xlCellTypeConstants, xlNumbers).Cells(1).Column
                If Not IsError(fc) Then
                    lc = Application.Match(9 ^ 99, .Rows(i))
                    On Error Resume Next
                    With .Range(.Cells(i, fc), .Cells(i, lc))
                        .SpecialCells(xlCellTypeBlanks).Cells.FormulaR1C1 = "=RC[-1]"
                        .Value = .Value2
                    End With
                End If
            End If
        Next i
    End With

End Sub

Answer 4

Just another solution:

The following code can help is there you need to auto-fill the previous values between 1st and last cells depending on value of 1st cell as mentioned in question Excel - VBA fill in cells between 1st and Last value

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim i As Long
    For i = 2 To Target.Column
        If Cells(Target.Row, i) = "" Then
            If Cells(Target.Row, i - 1) <> "" Then
                Range(Cells(Target.Row, i), Cells(Target.Row, i)).Value = Range(Cells(Target.Row, i - 1), Cells(Target.Row, i - 1)).Value
            End If
        End If
    Next i
End Sub

This sub is activated by clicking on any cell. Same cell marks the end of the loop i.e. to stop the loop just click the cell till which you want to fill the blank cells.