Copy non-blank cell into cell below, repeat for ea

Question

I have an Excel dataset that has a string in A1, and other values in B1, B2, and B3 that relate to A1; and so on down the page. Sometimes there are more than three cells that relate to the other string (unpredictable). In this example, cells A2 and A3 are blank. I want to create a macro that will fill A2 and A3 (etc) with the contents of A1.

In the example below I am using [] to help format it as Excel cells. I want to go from:

[SMITH, John]  [Home]
               [Mobile]
               [Work]
[DOE, John]    [Home]
               [Mobile]

to

[SMITH, John]  [Home]
[SMITH, John]  [Mobile]
[SMITH, John]  [Work]
[DOE, John]    [Home]
[DOE, John]    [Mobile]

I want the macro to repeat this for varying iterations, sometimes I have 1000 lines to adjust manually. Tweaking the software that outputs the data is not an option.

---

The code I have is as follows:

Sub rname()
Dim cellvar As String
Dim i As Integer

cellvar = ActiveCell
i = 0

While i < 50
If ActiveCell.Offset(1,0) = "" Then
ActiveCell.Offset(1,0) = cellvar
i = i + 1

ElseIf ActiveCell.Offset(1,0) = "*" Then
ActiveCell.Offset(1,0).Activate
i = i + 1

End If
Wend
End Sub

The above code adds text to the cell below the active cell once and then stops responding. The following code runs once and doesn't stop responding - I can run it again, but it doesn't automatically move down a row.

Sub repeat_name()

Dim cellvar As String
Dim i As Integer

cellvar = ActiveCell
i = 1

For i = 1 To 50

If ActiveCell.Offset(1, 0) = "" Then
    ActiveCell.Offset(1, 0) = cellvar
End If

If ActiveCell.Offset(1, 0) = "*" Then
    ActiveCell.Offset(1, 0).Select.Activate  'I have tried .Offset(2,0)too
End If

i = i + 1
Next

End Sub

I am stumped here. Does anyone have any thoughts or suggestions?

Answer 1

Try this:

Sub repeat_name()

Dim cellvar As String
Dim i As Integer
Dim ws As Worksheet

Set ws = Sheet1    'Change according to your sheet number
cellvar = ""
For i = 1 To 50

if Trim(ws.Range("A" & i )) <> "" then
 cellvar = Trim(ws.Range("A" & i ))
Else
 ws.Range("A" & i ) = cellvar
End if

Next i

End Sub

Answer 2

try this

Sub test()
lastrow = Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
    If Cells(i, 1) = "" Then
        Cells(i, 1) = Cells(i - 1, 1)
    End If
Next i
End Sub

Answer 3

Others have given working solutions, I'll just outline the problems with your code.

cellvar = ActiveCell assigns the value of the active cell to cellvar but cellvar won't change if ActiveCell changes so you'll just copy [SMITH, John] for all other people. You'd have to reassign cellvar.

If ActiveCell.Offset(1, 0) = "*" Then This checks if the cell contains an asterisk. Instead use Not ActiveCell.Offset(1, 0) = "", ActiveCell.Offset(1, 0) <> "", Not isEmpty(ActiveCell.Offset(1, 0)) or just Else (which would be the preferred version here since it doesn't require further calculations).

Edit: "*" Can be used as a wildcard with the Like operator as in If ActiveCell.Offset(1, 0) Like "*" Then but this would also be true for the empty string. To be sure that there is at least one sign you'd have to use "?*" instead. The question mark stands for exactly one character and the asterisk for 0 or more. To check if a cell is empty I would recommend one of the above ways though.

In you first sub this means that if the cell anything but "*", i will not be incremented and you end in an endless loop. In the second function, it means that the the active cell will not be changed and neither "" not "*" will be detected for the rest of the loop.

In the second sub, you don't need i=i+1, the for loop does that for you. This would mean that you increment i by 2 every iteration.

ActiveCell.Offset(1, 0).Select.Activate Here the "select" is too much

Here are the subs with minimal changes:

Sub rname()
    Dim cellvar As String
    Dim i As Integer

    cellvar = ActiveCell
    i = 0

    While i < 50
        If ActiveCell.Offset(1, 0) = "" Then
            ActiveCell.Offset(1, 0) = cellvar
            ActiveCell.Offset(1, 0).Activate 'the code will run without this but need to iterations per row
            i = i + 1
            MsgBox "a " & i

        Else
            ActiveCell.Offset(1, 0).Activate
            cellvar = ActiveCell        'reassign cellvar
            i = i + 1
            MsgBox "b " & i
        End If

    Wend
End Sub

second sub:

Sub repeat_name()

    Dim cellvar As String
    Dim i As Integer

    cellvar = ActiveCell
    'i = 1 'this is not necessary

    For i = 1 To 50

        If ActiveCell.Offset(1, 0) = "" Then
            ActiveCell.Offset(1, 0) = cellvar
        End If

        If Not ActiveCell.Offset(1, 0) = "" Then    'if else endif would be nicer here
            ActiveCell.Offset(1, 0).Activate        'remove "select"
            cellvar = ActiveCell    'reassign cellvar
        End If

        'i = i + 1 'this is not necessary/wrong
    Next i      'safer to include i

End Sub

Note that this is just to explain the problems with your code, I still recommend to use one of the other solutions here.

Answer 4

try this:

Sub repeat_name()

Dim k As Integer
Dim i As Integer

i = 1
k = ActiveSheet.UsedRange.Rows.Count

While i <= k
    With ActiveSheet
        If .Range("A1").Value = "" Then
            MsgBox "Error: First cell can not be empty."
            Exit Sub
        End If
        If .Range("A" & i).Value = "" And .Range("B" & i).Value <> "" Then
            .Range("A" & i).Value = .Range("A" & i - 1).Value
        End If
    End With
    i = i + 1
Wend

End Sub

Answer 5

Try it as,

Sub fillBlanks()
    With Worksheets("Sheet1")
        With .Range(.Cells(2, "B"), .Cells(Rows.Count, "B").End(xlUp))
            With .Offset(0, -1).SpecialCells(xlCellTypeBlanks)
                .FormulaR1C1 = "=R[-1]C"
            End With
            With .Offset(0, -1)
                .Value = .Value
            End With
        End With
    End With
End Sub

            
           ^{Before fillBlanks procedure                    After fillBlanks procedure}

Answer 6

How about this:

Sub FillBlanks()
    Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[-1]C"
End Sub