Create Rows Dynamically

[LuxCoder]

Hi,

I need to create new rows in separate worksheet based on number ranges. I think i can explain better with an example:

Existing Table

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]From[/TD]
[TD]To[/TD]
[TD]First Name[/TD]
[TD] Middle Name[/TD]
[TD]Last Name[/TD]
[/TR]
[TR]
[TD]100[/TD]
[TD]101[/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]214[/TD]
[TD]216[/TD]
[TD]X[/TD]
[TD]Y[/TD]
[TD]Z[/TD]
[/TR]
</tbody>[/TABLE]

Required Table

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]100[/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]101[/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]214[/TD]
[TD]X[/TD]
[TD]Y[/TD]
[TD]Z[/TD]
[/TR]
[TR]
[TD]215[/TD]
[TD]X[/TD]
[TD]Y[/TD]
[TD]Z[/TD]
[/TR]
[TR]
[TD]216[/TD]
[TD]X[/TD]
[TD]Y[/TD]
[TD]Z[/TD]
[/TR]
</tbody>[/TABLE]

Thanks in advance!

Lux

 

[MickG]

Try this for results starting "H1"

[COLOR="Navy"]Sub[/COLOR] MG08Apr15
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ray()
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]For[/COLOR] Ac = Dn.Value To Dn.Offset(, 1).Value
            c = c + 1
            ReDim Preserve Ray(1 To 4, 1 To c)
            Ray(1, c) = Ac: Ray(2, c) = Dn.Offset(, 2).Value
            Ray(3, c) = Dn.Offset(, 3).Value: Ray(4, c) = Dn.Offset(, 4).Value
        [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] Dn
Range("H1").Resize(c, 4) = Application.Transpose(Ray)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Peter_SSs]

Welcome to the MrExcel board!

Another variation to try (in a copy of your workbook). This assumes data in active sheet columns A:E & puts results in the same sheet columns H:K (though the results could be put anywhere of course).

Sub Make_Rows()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  
  With Range("A2", Range("E" & Rows.Count).End(xlUp))
    a = .Value
    ReDim b(1 To Evaluate("SumProduct(" & .Columns(2).Address & "-" & .Columns(1).Address & "+1)"), 1 To 4)
    For i = 1 To UBound(a)
      For j = a(i, 1) To a(i, 2)
        k = k + 1
        b(k, 1) = j: b(k, 2) = a(i, 3): b(k, 3) = a(i, 4): b(k, 4) = a(i, 5)
      Next j
    Next i
    .Offset(, .Columns.Count + 2).Resize(UBound(b, 1), UBound(b, 2)).Value = b
  End With
End Sub

 

[LuxCoder]

Thank you so much Sir,

It worked perfectly! Can you also please advice what if i have 3 more columns in first table of my question. How can i have n columns?

Regards

Lux

Welcome to the MrExcel board!

Another variation to try (in a copy of your workbook). This assumes data in active sheet columns A:E & puts results in the same sheet columns H:K (though the results could be put anywhere of course).

Sub Make_Rows()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  
  With Range("A2", Range("E" & Rows.Count).End(xlUp))
    a = .Value
    ReDim b(1 To Evaluate("SumProduct(" & .Columns(2).Address & "-" & .Columns(1).Address & "+1)"), 1 To 4)
    For i = 1 To UBound(a)
      For j = a(i, 1) To a(i, 2)
        k = k + 1
        b(k, 1) = j: b(k, 2) = a(i, 3): b(k, 3) = a(i, 4): b(k, 4) = a(i, 5)
      Next j
    Next i
    .Offset(, .Columns.Count + 2).Resize(UBound(b, 1), UBound(b, 2)).Value = b
  End With
End Sub

 

[Peter_SSs]

Thank you so much Sir,

It worked perfectly!

That's a good start.

Can you also please advice .... How can i have n columns?

If the data starts in A1 and row 1 can be used to determine the number of columns of data, then try:

Sub Make_Rows_v2()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, c As Long, uba2 As Long
  
  With Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, Cells(1, Columns.Count).End(xlToLeft).Column)
    a = .Value
    uba2 = UBound(a, 2)
    ReDim b(1 To Evaluate("SumProduct(" & .Columns(2).Address & "-" & .Columns(1).Address & "+1)"), 1 To UBound(a, 2) - 1)
    For i = 1 To UBound(a)
      For j = a(i, 1) To a(i, 2)
        k = k + 1: b(k, 1) = j
        For c = 3 To uba2
          b(k, c - 1) = a(i, c)
        Next c
      Next j
    Next i
    .Offset(, .Columns.Count + 2).Resize(UBound(b, 1), UBound(b, 2)).Value = b
    .Offset(-1, .Columns.Count + 3).Resize(1, uba2 - 2).Value = .Offset(-1, 2).Resize(1, uba2 - 2).Value
    .Offset(-1, .Columns.Count + 2).Cells(1).Value = "Number"
    .Offset(, .Columns.Count + 2).CurrentRegion.Columns.AutoFit
  End With
End Sub