Duplicating rows and change two columns, based on a values in the row. In Excel

Question

I'm trying to take a stock listing and generate duplicate rows for each of the SKUs - our postal software needs each seperate SKU on its own line.

I'm an utter noob at VBA, can anyone give me a hand?

Here's the basic logic:

1. Look at columns B-F. Count how many have a value (are not empty). 
- Set variable numofrows to that count.
- Set variables Bvalue, Cvalue, Dvalue, Evalue and Fvalue

2. Whilst numofrows is more than 1, do the following:

- Check if Bvalue is more than zero. 
- If it is, change column F to say "SKU1", and column G to be the same value as Bvalue. 
- Set Bvalue to empty. Set numofrows to be current value -1. Restart loop.

Repeat above for C through F.

Example of input data

Name	SKU1	SKU2	SKU3	SKU4	SKU5	Weight
Andrew	1		1			0.6
Bob		3				0.4
Carwen	1	1	1	1	1	1.2
Dave				2	1	0.7
Elizabeth			1			0.3

Example of output data

Name	SKU1	SKU2	SKU3	SKU4	SKU5	Weight	SKU	SKU quantity
Andrew	1		1			0.6	SKU1	1
Andrew	1		1			0.6	SKU3	1
Bob		3				0.4	SKU2	3
Carwen	1	1	1	1	1	1.2	SKU1	1
Carwen	1	1	1	1	1	1.2	SKU2	1
Carwen	1	1	1	1	1	1.2	SKU3	1
Carwen	1	1	1	1	1	1.2	SKU4	1
Carwen	1	1	1	1	1	1.2	SKU5	1
Dave				2	1	0.7	SKU4	2
Dave				2	1	0.7	SKU5	1
Elizabeth			1			0.3	SKU3	1

My actual column headers:

Here's the actual headers off my spreadsheet:

Backer Num	Name	Email	Full Name	Address1	Address2	City	State/Province/Region	Zip Code	Country/Region	Country/Region Code	Phone Number	Total Order Weight(kg)	DUN1	Book5	SKUexample	MoreBookSKU	Other	SKUsheets	Size
188	Example	[email protected]	Biggles	123 Lala land		Walestown	WL	12345	United States	US	41414141414	0.25	1	2	1	4	5	1	Large Letter

Answer 1

• Load data into an array and convert it in memory.

Microsoft documentation:

Range.CurrentRegion property (Excel)

IsNumeric function

Range.Resize property (Excel)

Option Explicit

Sub Demo()
    Dim i As Long, j As Long, k As Long
    Dim arrData, rngData As Range
    Dim arrRes, iR As Long
    Dim LastRow As Long
    Dim oSht As Worksheet
    Set oSht = Sheets("Sheet1") ' modify as needed
    Set rngData = oSht.Range("A1").CurrentRegion
    arrData = rngData.Value
    Dim RowCnt As Long, ColCnt As Long
    RowCnt = UBound(arrData)
    ColCnt = UBound(arrData, 2)
    ReDim arrRes(1 To RowCnt * (ColCnt - 2), 1 To ColCnt + 2)
        For j = LBound(arrData, 2) To UBound(arrData, 2)
            arrRes(1, j) = arrData(1, j)
        Next j
    arrRes(1, j) = "SKU"
    arrRes(1, j + 1) = "SKU Quantity"
    iR = 1
    For i = LBound(arrData) + 1 To UBound(arrData)
        For k = LBound(arrData, 2) + 1 To UBound(arrData, 2) - 1
            If Val(arrData(i, k)) > 0 And Len(arrData(i, k)) > 0 And IsNumeric(arrData(i, k)) Then
                iR = iR + 1
                For j = LBound(arrData, 2) To UBound(arrData, 2)
                    arrRes(iR, j) = arrData(i, j)
                Next
                arrRes(iR, j) = arrData(1, k)
                arrRes(iR, j + 1) = arrData(i, k)
            End If
        Next k
    Next i
    Sheets.Add
    Range("A1").Resize(iR, UBound(arrRes, 2)).Value = arrRes
End Sub