Add Header to Each Record As Row-CodePudding

I receive an excel file with the below format:

But I need it to be the below format:

I have the blow code but it's not working.

Sub Format_Click()

Dim ws1 As Worksheet
Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet
Set ws2 = Sheets("Sheet2")
Dim count As Integer
Dim rng As Range
Set rng = ws1.UsedRange
ws2.Cells(1, 1) = "Contract"
ws2.Cells(1, 2) = "Code"
ws2.Cells(1, 3) = "Price"

For i = 1 To rng.Columns.count
For j = 2 To rng.Rows.count
count = ws2.Range("A" & ws2.Rows.count).End(xlUp).Row
ws2.Cells(count   1, 1) = rng.Cells(1, i)
ws2.Cells(count   1, 2) = rng.Cells(j, i)
ws2.Cells(count   1, 3) = rng.Cells(j, 1)
Next j
Next i

End Sub

CodePudding user response：

Take all the data into an array, loop trough once and detect categories (categories are values with no qty according to your image).

My code shows output in same sheet but in can bee easily adapted to make output in a different worksheet:

Sub test()
Dim i As Long
Dim j As Long
Dim LR As Long
Dim MyData As Variant
Dim CurrentCat As String

LR = Range("A" & Rows.Count).End(xlUp).Row

MyData = Range("A1:B" & LR).Value

Range("D1").Value = "Category"
Range("E1").Value = "Name"
Range("F1").Value = "Qty"

j = 2
For i = LBound(MyData) To UBound(MyData) Step 1
    If MyData(i, 2) = "" Then
        'its a Category if there is no qty
        CurrentCat = MyData(i, 1)
    Else
        'there is data
        Range("D" & j).Value = CurrentCat
        Range("E" & j).Value = MyData(i, 1)
        Range("F" & j).Value = MyData(i, 2)
        j = j   1
    End If
Next i

Erase MyData

End Sub

Consider reading about arrays, pretty useful:

Excel VBA Array – The Complete Guide