Duplicate Cell Referencing

[Akali_H]

Hi Team,

I'm in need of an excel formula or VBA Code that can assist me reference column of unique values (Column A) and have each of them duplicated in 11 rows of another column (Column B). For example:
[TABLE="width: 500"]
<TBODY>[TR]
[TD]Column A[/TD]
[TD]Column B[/TD]
[/TR]
[TR]
[TD]Apple[/TD]
[TD]Apple[/TD]
[/TR]
[TR]
[TD]Orange[/TD]
[TD]Apple[/TD]
[/TR]
[TR]
[TD]Mango[/TD]
[TD]Apple[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Apple[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Apple[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Apple[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Apple[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Apple[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Apple[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Apple[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Apple[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Orange[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Orange[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Orange[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Orange[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Orange[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Orange[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Orange[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Orange[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Orange[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Orange[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Orange[/TD]
[/TR]
</TBODY>[/TABLE]

 

[Andrew Poulsom]

In A2 copied down:

=IFERROR(INDEX(B$2:B$34,MATCH(0,INDEX(COUNTIF(A$1:A1,B$2:B$34),),FALSE)),"")

 

[Arithos]

You need a formula/macro to create 11 duplicates in another column?

 

[Arithos]

I have a Macro suggestion. Like so.

Sub MakeDuplicates()


LR = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To LR
FR = Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row
    For j = FR To FR + 11
        Cells(j, 2).Value = Cells(i, 1).Value
    Next j
Next i


End Sub

 

[Andrew Poulsom]

You need a formula/macro to create 11 duplicates in another column?

I misread the question. That would be in B1 copied down:

=INDEX(A:A,INT((ROWS(B$1:B1)-ROW(B$1))/11)+1)

 

[ParamRay]

.
.

For VBA solution:

Sub DuplicateRecords()

    Dim Rang As Range
    Dim Cell As Range
    Dim Num As Long
    
    With ActiveSheet
        Set Rang = Intersect(.Columns("A"), .UsedRange)
    End With
    
    Num = 0
    For Each Cell In Rang
        With Cell
            .Offset(10 * Num, 1).Resize(11, 1).Value = .Value
        End With
        Num = Num + 1
    Next Cell

End Sub

 

[Akali_H]

Thanks a lot Andrew Poulsom, Arithos and GPeacock. All your solutions have worked great!! Once again Thanks.