[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 328
  • Last Modified:

REPEAT ROWS ACCORDING TO CELL VALUE

Hi,

Attached is a file that contains a sample table that I obtain from a Pivot Table displaying the parts of the product that I need to print the stickers.

What I need is that each row displayed in the Original table (Rows 3 to 8) must be repeated as many times as the value in column D ("Qty") of each row.

The Quantity of rows will change according the product to produce it's stickers...
I don't care if the result goes in the same Sheet or in a different one.

Please see the attachment showing the original table and the final result that I need.

Thank you in advance for your help and time,
Roberto.
EE-STICKERS.xls
0
Pabilio
Asked:
Pabilio
2 Solutions
 
StephenJRCommented:
Roberto - try this, results on sheet2:
Sub x()

Dim r As Long

With Sheet1
    .Range("A3:H3").Copy Sheet2.Range("A1")
    For r = 4 To .Range("A" & Rows.Count).End(xlUp).Row
        .Cells(r, 1).Resize(, 8).Copy Sheet2.Range("A" & Rows.Count).End(xlUp)(2).Resize(.Cells(r, 4))
    Next r
End With

End Sub

Open in new window

0
 
nutschCommented:
Here's my take on it

Sub RepeatLines()
'repeat each line how many times as needed
Dim lLastRow As Long, lRowLoop As Long

application.ScreenUpdating = False
application.Calculation = xlCalculationManual
application.DisplayAlerts = False

lLastRow = Cells(Rows.Count, 1).End(xlUp).Row

For lRowLoop = lLastRow To 2 Step -1
    If Cells(lRowLoop, "D") > 1 Then
        Rows(lRowLoop + 1 & ":" & lRowLoop + Cells(lRowLoop, "D") - 1).Insert
        Rows(lRowLoop).Copy Rows(lRowLoop + 1 & ":" & lRowLoop + Cells(lRowLoop, "D") - 1)
    End If
Next

application.ScreenUpdating = True
application.Calculation = xlCalculationAutomatic
application.DisplayAlerts = True

End Sub

Open in new window


Thomas
0
 
PabilioAuthor Commented:
Dear Thomas and Stephen,

Both codes works perfectly.
I really appreciatte your help.
Thank you very much for your time.

Cheers,
Roberto.
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now