Auto populate cells

[yuenk]

I understand that once a cell is highlighted you can drag it to populate the following cells. Is there a function that can do this automatically to the next populated cell? The reason being is that my report has hundreds of lines and its too time consuming doing this one name at a time.

What I have now

Name	Grade
Ted	3
	3
	3
Susan	4
	3

What I want

Name	Grade
Ted	3
Ted	3
Ted	3
Susan	4
Susan	3

Thanks

[AlKey]

Enter in D2 and copy down

=LOOKUP("zzzz",A$2:A2)

Enter in E2 and copy down

=LOOKUP(10^308,B$2:B2)

v	A	B	C	D	E
1	Name	Grade		Name	Grade
2	Ted	3		Ted	3
3		3		Ted	3
4		3		Ted	3
5	Susan	4		Susan	4
6		3		Susan	3
7

[yuenk]

Thanks but is there any way to do this without having to create formulas or extra tables?

[AlKey]

Thanks but is there any way to do this without having to create formulas or extra tables?

If formula is not an option you would have to look for a VBA solution.

[Greg M]

Hi there,

See if the following code does what you need:

Option Explicit


Sub CopyNames()

    Const iFIRST_ROW_NO As Integer = 1
    Const sCOLUMN_GRADE As String = "B"
    Const sCOLUMN_NAME  As String = "A"
    Const sSHEETNAME    As String = "Sheet1"

    Dim rFillDownRange  As Range
    Dim rColumn_Grade   As Range
    Dim lLastRowNo      As Long
    Dim rFirstCell      As Range
    Dim rLastCell       As Range
    Dim wks             As Worksheet

    Set wks = ThisWorkbook.Worksheets(sSHEETNAME)

    With wks
        Set rColumn_Grade = Intersect(.UsedRange.EntireRow, _
                                      .Columns(sCOLUMN_GRADE))
    End With

    With rColumn_Grade
        lLastRowNo = .Rows(.Rows.Count).Row
    End With

    Set rFirstCell = wks.Range(sCOLUMN_NAME & iFIRST_ROW_NO)

    Do

        If rFirstCell.Offset(1, 0).Value = vbNullString Then

              Set rLastCell = rFirstCell.End(xlDown).Offset(-1, 0)

              If rLastCell.Row > lLastRowNo Then
                  Set rLastCell = wks.Range(sCOLUMN_NAME & lLastRowNo)
              End If

              Set rFillDownRange = Range(rFirstCell, rLastCell)

              With rFillDownRange
                  .Value = .Cells(1, 1).Value
              End With

              Set rFirstCell = rLastCell.Offset(1, 0)

        Else: Set rFirstCell = rFirstCell.Offset(1, 0)

        End If

    Loop Until rLastCell.Row = lLastRowNo

End Sub

The highlighted values may be altered to suit your own requirements.


Hope this helps - please let me know how you get on.

Regards,

Greg M

[JOHN H. DAVIS]

Maybe:

Sub yuenk()
Dim rcell As Range
For Each rcell In Range("A2:A" & Range("B" & Rows.Count).End(3).row)
    If rcell = "" Then rcell = rcell.Offset(-1)
Next rcell
End Sub

[yuenk]

Thanks this works! This is simple enough too