creating rows generated from one master sheet

[JeremyM8888]

Google Sheet Link


First sheet is for generating the output in the second sheet. You can see there is no referencing currently. I included a couple minor notes in the first sheet.


The challenge is how to achieve the same output in the most efficient, yet simplest way possible based on input from sheet 1.

I imported the excel sheet to Google sheets and included the link up top as I was not sure how else I could attach or best allow someone to work with the spreadsheet.

 

[dfsobral]

and what do you want exactly

 

[igold]

See if this gets you close...

Please note that the code is assuming that you already have the header row written on the "SZ-After" sheet. Additionally, there is no shading of sections in the code.

Sub Tip()
    
    Dim wsB As Worksheet: Set wsB = Worksheets("SZ-Before")
    Dim wsA As Worksheet: Set wsA = Worksheets("SZ-After")
    Dim SZ As Long, os As Long, Tv As Long, osct As Long
    Dim lRow As Long, i As Long, ii As Long, ctr As Long, s As Long
    Dim arr1, arr2
    
    lRow = wsB.Cells(Rows.Count, 1).End(xlUp).Row
    Tv = WorksheetFunction.Sum(wsB.Range("A2:A" & lRow)) * 10
    
    ReDim arr2(1 To Tv, 1 To 13)
    arr1 = wsB.Range("A2:F" & lRow)
        ctr = 1
        SZ = 1
        os = 1
        osct = 1
    For i = LBound(arr1) To UBound(arr1)
        For ii = 1 To arr1(i, 1) * 10
            s = ii Mod arr1(i, 1)
            If s = 0 Then s = arr1(i, 1)
            arr2(ctr, 3) = s
            arr2(ctr, 1) = arr1(i, 1)
            If arr1(i, 1) > 1 Then
                arr2(ctr, 2) = os
                osct = osct + 1
                If osct > arr1(i, 1) Then
                    os = os + 1
                    osct = 1
                End If
            End If
            If arr1(i, 1) = 1 Then
                If arr2(ctr, 1) = 1 Then
                    arr2(ctr, 1) = ""
                    If SZ > 10 Then SZ = 1
                    arr2(ctr, 2) = SZ
                    SZ = SZ + 1
                End If
            End If
            arr2(ctr, 5) = arr1(i, 2)
            arr2(ctr, 8) = arr1(i, 3)
            arr2(ctr, 9) = arr1(i, 4)
            arr2(ctr, 10) = arr1(i, 5)
            arr2(ctr, 11) = arr1(i, 6)
            If arr2(ctr, 1) = "" Then
                arr2(ctr, 6) = arr2(ctr, 5) & "_" & arr2(ctr, 2)
            Else
                arr2(ctr, 6) = arr2(ctr, 5) & "_" & arr2(ctr, 2) & "_" & arr2(ctr, 3)
            End If
            ctr = ctr + 1
        Next
        os = 1
    Next
    wsA.Range("A2").Resize(UBound(arr2, 1), UBound(arr2, 2)).Value = arr2
    
End Sub

I hope this helps.

 

[JeremyM8888]

Thanks igold! Appreciate it!

I am getting a runtime error (out of range) however. Check screenshot below with error highlighted.

https://snag.gy/fzjkbq.jpg

 

[igold]

Are you using the exact same sheet as you posted on Google? I tested it extensively with what was posted and it worked fine.

If you want to PM me with your email, I would be happy to send you my test workbook...

 

[JeremyM8888]

Thanks, I sent pm. Will test macro on your workbook when you send...