Disaggregating data

afndst

New Member
Joined
Sep 8, 2015
Messages
35
Hello

Does anyone know VBA code to transform X into Y?

XFY
111
222
312
3

<colgroup><col width="64" span="3" style="width: 48pt; text-align: right;"> </colgroup><tbody>
</tbody>
Regards

António Teixeira
 

Some videos you may like

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
75,559
Office Version
365
Platform
Windows
Try this.

Code:
Sub Disaggregate()
Dim arrIn As Variant
Dim arrOut()
Dim I As Long
Dim J As Long
Dim cnt As Long

    arrIn = Range("A2:B4")
    
    ReDim arrOut(1 To Application.Sum(Application.Index(arrIn, , 2)), 1 To 1)
    
    For I = LBound(arrIn) To UBound(arrIn)
    
        For J = 1 To arrIn(I, 2)
            cnt = cnt + 1
            
            arrOut(cnt, 1) = arrIn(I, 1)
        Next J
    
    Next I
    
    Range("C2").Resize(UBound(arrOut)).Value = arrOut
    
End Sub
 

afndst

New Member
Joined
Sep 8, 2015
Messages
35
Hello

It works perfectly.

Thank you very much

Try this.

Code:
Sub Disaggregate()
Dim arrIn As Variant
Dim arrOut()
Dim I As Long
Dim J As Long
Dim cnt As Long

    arrIn = Range("A2:B4")
    
    ReDim arrOut(1 To Application.Sum(Application.Index(arrIn, , 2)), 1 To 1)
    
    For I = LBound(arrIn) To UBound(arrIn)
    
        For J = 1 To arrIn(I, 2)
            cnt = cnt + 1
            
            arrOut(cnt, 1) = arrIn(I, 1)
        Next J
    
    Next I
    
    Range("C2").Resize(UBound(arrOut)).Value = arrOut
    
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,099,115
Messages
5,466,765
Members
406,497
Latest member
Bryanlim

This Week's Hot Topics

Top