Copying cells till blank rows end

**SOS** · 09-05-2008, 09:56 AM

Hi all,

I have data in A2, then blank till A18 (variable number each time), then data in A19 and blank till A35 (and more and more).

Using VBA how would I code to copy A1 into every cell till A18, then copy A19 into every cell till A35 and so on.

Perhaps using SpecialCells(xlTypeConstant) or something?

Thanks in adance

Seamus

**SOS** · 09-05-2008, 10:00 AM

Should have done some more searching before posting - I found the answer.

Sub FillColBlanks()
Dim wks As Worksheet
Dim rng As Range
Dim LastRow As Long
Dim col As Long

Set wks = ActiveSheet
With wks
   col = ActiveCell.Column
   Set rng = .UsedRange
   LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
   Set rng = Nothing
   On Error Resume Next
   Set rng = .Range(.Cells(2, col), .Cells(LastRow, col)) _
                  .Cells.SpecialCells(xlCellTypeBlanks)
   On Error GoTo 0
   If rng Is Nothing Then
       MsgBox "No blanks found"
       Exit Sub
   Else
       rng.FormulaR1C1 = "=R[-1]C"
   End If
   With .Cells(1, col).EntireColumn
       .Value = .Value
   End With
End With
End Sub

**royUK** · 09-05-2008, 10:08 AM

Why not adapt the code that I gave you earlier?

Dim rng   As Range
    Dim cl     As Range

    Set rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
    For Each cl In rng
        If Not IsEmpty(cl) Then cl.Offset(1, 0).Value = cl.Offset(-1, 0).Value
    Next cl

**SOS** · 09-05-2008, 10:22 AM

Roy,

That code appears to say:

If A2 is not empty then A3's value = A1's Value.

So if I have data in A2 and want it copied down to A10 your code takes A1's value (header cell) and places it in A3, then takes A2's value (hospital name) and places it in A4 and so on.

Sorry

Seamus

**MickG** · 09-05-2008, 10:21 AM

Hi Here's an alternative

Dim Last As Integer, oData, Dn As Integer
Last = Range("A" & Rows.Count).End(xlUp).Row

For Dn = 1 To Last
        oData = Cells(Dn, "A")
    Do While Cells(Dn, "A") = "" Or Cells(Dn, "A") = oData
        Cells(Dn, "A") = oData
            Dn = Dn + 1
                If Dn > Last Then Exit Sub
         Loop
    
    oData = Cells(Dn, "A")
    Dn = Dn - 1
Next Dn

Regards Mick