Loop through cells to create a sequence

Question

I am having difficulties in trying to loop my cell column values to fulfill a series that copies data depending on the count of data. This is what I need to do

A1 AA     B1 2     C1 AA
A2 AA     B2 2     C2 AB
A3 AB     B3 2     C3 AC
A4 AB     B4 1     C4 AD
A5 AC     B5       C5
A6 AC     B6       C6
A7 AD     B7       B7

Column B tells how many times C will show in A
I need to loop Columns B and C to create the series in Column A

How can I loop through cells to display the values in series while ignoring the blank cells?

I tried looping one cell, but I cannot create a loop through each cell.

Sub loop_cells()
Dim var As Long
Set Rng = Range("C1")
var = Range("B2").Value
i = 1

Do Until i = var
Range("A1:A" & var).Value = Rng
i = i + 1

Loop
End Sub

user_11732320 · Answer

If you want a VBA Solution this should work:

Sub doSomeLooping()
Dim WS As Worksheet, aCell As Range, i As Long, j As Long
    Set WS = ActiveSheet 'or whatever.

ReDim SomeValues(j)

For Each aCell In Intersect(WS.Range("C:C"), WS.UsedRange).Cells
    If Not IsEmpty(aCell) Then
        For i = 1 To aCell.Offset(0, -1).Value
            ReDim Preserve SomeValues(j)
            SomeValues(j) = aCell.Value
            j = j + 1
        Next i
    End If
Next aCell

WS.Range("A1").Resize(UBound(SomeValues), 1).Value = _
    Application.WorksheetFunction.Transpose(SomeValues)

End Sub

I also think you can get what you need with just a formula, if you have spill range. Consider this function in cell A1.

=FILTERXML(""&SUBSTITUTE(LEFT(TEXTJOIN("",FALSE,FILTER(REPT(C:C&"!",B:B),B:B<>"")),LEN(TEXTJOIN("",FALSE,FILTER(REPT(C:C&"!",B:B),B:B<>"")))-1),"!","")&"","//y")

Loop through cells to create a sequence

1 Answers