Best Approach to populating / autofilling values to repeat 2

[cojeda]

I have data in Excel that is missing repeating values.

It looks like this...

ID Accnt
10 111

222


333
20 444


555

777

...but I wish to have the repeating values added...

ID Accnt
10 111
10 111
10 222
10 222
10 222
10 333
20 444
20 444
20 444
20 555
20 777
20 777

I've messed with some macros...but the problem is that the number of rows for each ID may vary as well as the number of account rows for each ID. Also the order may vary. Thus, I'd need an approach that can tackle this columb by column. It would have to start at row 1, and copy or fill down the same value up until the new value below. Then the process would need to repeat.

Not sure whether auto fill or auto copy or what is the best approach.

Any help would be appreciated.

Thanks!

Chris

 

[ddcroit]

Dear cojeda,

The best way to tackle this issue is to create a looping procedure.

Use the procedure below. More efficient coding might exist for this issue but this will work.

Sub FillValues()

Dim q As Variant

'Need to create the range properly

Range(Range("a2"), Range("b65000").End(xlUp).Offset(0, -1)).Select
Range("a2").Activate

'Loop

For Each q In Selection
If q.Value = "" And q.Row > 1 Then q.Value = Cells(q.Row - 1, q.Column)
Next q

'For other columns

Range(Range("b2"), Range("b65000").End(xlUp)).Select
Range("b2").Activate

'loop

For Each q In Selection
If q.Value = "" And q.Row > 1 Then q.Value = Cells(q.Row - 1, q.Column)
Next q

End Sub

 

[SoCalAccessPro]

That's a pretty simple for next:

Public Sub FillIt()
Dim tmpValue

tmpValue = ActiveSheet.Cells(1, 1)
Cells(2, 1).Activate
For i = 2 To 38 ' or your last row
    If ActiveSheet.Cells(i + 1, 1) = "" Then 'cell below current cell
        ActiveSheet.Cells(i, 1) = tmpValue
    Else
        ActiveSheet.Cells(i, 1) = tmpValue
        tmpValue = Cells(i + 1, 1)
    
    End If
Next i
End Sub

Tyrone Lumley
SoCalAccessPro

http://www.socalaccesspro.com

 

[AnotherHiggins]

Very quickly fixed without VBA:

Data > Filter > Auto Filter

For Column A, Filter on Blanks

Select all cells in column A - except for the header record - all the way down to the end of the used rows

type in [COLOR=blue white]=[/color] and press the Up Arrow

Press [Ctrl]+[Enter]

Data > Filter > Auto Filter

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ 181-2886 before posting.

 

[cojeda]

You both ROCK! Thanks so very much. Probably was easy for you guys, but I was getting error after error as I am new to VBA.

 

[AnotherHiggins]

Even using VBA, I'd avoid looping. Using AutoFilter is faster.

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ 181-2886 before posting.

 

[AnotherHiggins]

intLstRow = _
        Range("C" & ActiveSheet.Rows.Count).End(xlUp).Row

ActiveSheet.AutoFilterMode = False

Cells.AutoFilter _
        Field:=2, _
        Criteria1:="="
Range("B3:B" & intLstRow). _
        SpecialCells(xlCellTypeVisible). _
        FormulaR1C1 = "=R[-1]C"

Cells.AutoFilter _
        Field:=2

Cells.AutoFilter _
        Field:=1, _
        Criteria1:="="
Range("A3:A" & intLstRow). _
        SpecialCells(xlCellTypeVisible). _
        FormulaR1C1 = "=R[-1]C"

ActiveSheet.AutoFilterMode = False

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ 181-2886 before posting.

 

[ddcroit]

AnotherHiggins,

I have really learnt from you. Please have a look at the coding below.
It's very similar to yours but might be interesting

Sub MyRangeFills()

Dim MyRange As Range

Set MyRange = _
Range(Range("a2"), Range("a" & ActiveSheet.Rows.Count).End(xlUp))

Range(Range("a1"), Range("a" & ActiveSheet.Rows.Count).End(xlUp)) _
.Cells.AutoFilter Field:=1, Criteria1:="="

MyRange.FormulaR1C1 = "=R[-1]C"

ActiveSheet.AutoFilterMode = False

End Sub

 

[Gavona]

You don't even need Autofilter. Also I would suggest converting the formulae to values as the last step.

Sub test()
Dim myRange As Range
Set myRange = Selection

With myRange
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    .Copy
    .PasteSpecial (xlPasteValues)
End With
End Sub

Gavin