VBA script that will allow me to copy the unit # in column C to the empty cells below unti

I would like to create a VBA script that will allow me to copy the unit # in column C to the empty cells below until it reaches the next unit #, then copies that unit # to the empty cells below it until it reaches the next unit# and so on.

I have attached a sample excel spreadsheet.

Really appreciate any help.

Thanks

Option Explicit

Sub UnitNumbers()
Application.ScreenUpdating = False
Dim lr As Long, ws As Worksheet, a, r As Range
Set ws = Worksheets("Sheet1")
lr = ws.Cells(Rows.Count, "F").End(xlUp).Row
Set a = ws.Range("C6:C" & lr).SpecialCells(xlCellTypeBlanks).Areas
    For Each r In a
        r.NumberFormat = r(0).NumberFormat
        r.Value = r(0)
    Next r
Application.ScreenUpdating = True
End Sub

Hi there,

Assuming the first Unit code to copy is in cell C6 (row 6).

Try the code below;

Option Explicit

Sub FillUnitDown()

Dim cell As Range
Dim lRow As Integer

lRow = Cells(Rows.Count, 6).End(xlUp).Row   ' 6 = column F to which end we fill down to.

Range("C6:C" & lRow).Select     ' Assumming the first Unit number is in row 6

For Each cell In Selection
  If cell = "" Then
    cell.FillDown
  End If
Next

End Sub

Hi FFarah,

this is another version

Sub UpdateUnit()

    Dim urF As Long
    Dim Row As Long
    
    urF = Cells(Rows.Count, "F").End(xlUp).Row                ' last row in column "F"
    Row = 6                                                   ' starting row
    
    Application.ScreenUpdating = False                        ' disable screen update
    Do While Row <= urF
        If Len(Cells(Row, 3).Text) = 0 Then
            Cells(Row - 1, 3).Copy Cells(Row, 3)
        End If
        Row = Row + 1
    Loop
    Application.ScreenUpdating = True                         ' enable screen update
    
End Sub

Try and let us know.

Bye

P.S.: if you want only value of cell, modify

Cells(Row - 1, 3).Copy Cells(Row, 3)

with

Cells(Row - 1, 3).Value = Cells(Row, 3).Value

Or try this. No loop.

Option Explicit

Sub sFillBlanks()

Dim lLR As Long, rRng As Range

Application.ScreenUpdating = False
On Error GoTo lblExit

lLR = Range("F" & Rows.Count).End(xlUp).Row
Set rRng = Range("C6:C" & lLR).SpecialCells(xlCellTypeBlanks)
rRng.FormulaR1C1 = "=R[-1]C"
Set rRng = Range("C6:C" & lLR)
With rRng
    .NumberFormat = "@"
    .Value = .Value
End With

lblExit:
Application.ScreenUpdating = True

End Sub

Thanks for the rep.

Let us know how you get on.

You're welcome.