Reformat Sales Data and Annualized Unit Data

Option Explicit


Sub FormatMe()
Dim ws1 As Worksheet: Set ws1 = Sheets(1)
Dim ws2 As Worksheet: Set ws2 = Sheets(2)
Dim Irng As Range, Orng As Range
Dim i As Long, j As Long, x As Long
Set Irng = Application.InputBox("Select the table range", Title:="Range Selector", Type:=8)
SetRng:
Set Orng = Application.InputBox("Select the first cell of the output range.", Title:="Range Selector", Type:=8)
If Orng.Rows.Count > 1 Or Orng.Columns.Count > 1 Then
MsgBox "Only select the first cell of the output range."
GoTo SetRng
End If
For i = 1 To 3
Orng.Cells(1, i) = Irng.Cells(1, i)
Next i
Orng.Cells(1, 4) = "Year"
Orng.Cells(1, 5) = "Units"
x = 2
For i = 2 To Irng.Rows.Count
For j = 4 To Irng.Columns.Count
Orng.Cells(x, 1) = Irng.Cells(i, 1)
Orng.Cells(x, 2) = Irng.Cells(i, 2)
Orng.Cells(x, 3) = Irng.Cells(i, 3)
Orng.Cells(x, 4) = Irng.Cells(1, j)
Orng.Cells(x, 5) = Irng.Cells(i, j)
x = x + 1
Next j
Next i
End Sub

Sub Reformat()
    Dim x, y, Hdrs, i&, ii&, iii&
    Hdrs = Array("Product", "Company", "Activity", "Year", "Units")
    x = Sheets("Data").Cells(1).CurrentRegion 'CHANGE SHEET NAME TO SUIT
    ReDim y(1 To (UBound(x, 1) - 1) * (UBound(x, 2) - 3) + 1, 1 To 5)
    iii = 1
    
    For i = 2 To UBound(x, 1)
        For ii = 2 To UBound(x, 2) - 2
            iii = iii + 1
            y(iii, 1) = x(i, 1): y(iii, 2) = x(i, 2): y(iii, 3) = x(i, 3)
            y(iii, 4) = x(1, ii + 2): y(iii, 5) = x(i, ii + 2)
        Next
    Next
    For i = 0 To UBound(Hdrs)
        y(1, i + 1) = Hdrs(i)
    Next
    With Sheets("Reformat")
        .Rows(1).Resize(10000).Clear
        .[a1].Resize(UBound(y, 1), 5) = y
        .Columns.AutoFit
        .Activate
    End With
    
End Sub