You sent me a sensitive document via private email. I will send one back with this macro in it. There's a button on Sheet1 (a new sheet) which runs this macro (it's hard-coded to your data as you have it).
Code:
Sub blah2()
Set rngSceData = Sheets("Item").Range("A1:DU96277")
ResultsRowCount = Application.CountA(Intersect(rngSceData, rngSceData.Offset(3, 15)))
ReDim Results(1 To ResultsRowCount / 2 + 1, 1 To 19)
Hdrs = Array("Group Name", "Dept Name", "Dept", "Supplier Name", "Vpn", "Phase Desc", "Item Code", "Diff 3", "Color", "Shade", "Item Desc", "Class Name", "Subclass", "Season Name", "First Trf Date", "Destination", "Location", "Sold Qty1", "Soh")
SceData = rngSceData.Value
'row 4,colm 16 is start of data
resultrow = 1
For i = 0 To UBound(Hdrs)
Results(resultrow, i + 1) = Hdrs(i)
Next i
For rw = 4 To UBound(SceData)
For colm = 16 To UBound(SceData, 2) Step 2
If Not (IsEmpty(SceData(rw, colm)) And IsEmpty(SceData(rw, colm + 1))) Then
'Stop
'rngSceData.Cells(rw, colm).Resize(, 2).Select
resultrow = resultrow + 1
For c = 1 To 15
Results(resultrow, c) = SceData(rw, c)
Next c
Results(resultrow, 16) = SceData(1, colm) 'dest
Results(resultrow, 17) = SceData(2, colm) 'locn
'Debug.Assert SceData(3, colm) = "Sold Qty1"
Results(resultrow, 18) = SceData(rw, colm) 'Sold Qty1
'Debug.Assert SceData(3, colm + 1) = "Soh"
Results(resultrow, 19) = SceData(rw, colm + 1) 'Soh
End If
Next colm
Next rw
With Sheets("Sheet1")
.Range("A1").Resize(Rows.Count - 2, UBound(Results, 2)) = Results 'this one line takes about 30 secs!
End With
End Sub
There's a problem with your data. There's a fair bit of it. In order to transform the data as before it would need 4,319,950 rows (that's ignoring all blank cells). I can halve this number by having separate columns for
Stock and
Sold, which I've done, but this still requires 2,159,976 which is more than a single Excel sheet will take (just over 1 million).
However, the full data set is computed in-memory, I only put the first million or so rows on the sheet, so the data is truncated, and it's useless.
Clicking that button will bring up that data (it's empty at the moment to keep the file size reasonable). It takes 40 seconds or so to run here, with most of that time (30 secs) taken up reading from and writing to the sheets.
There's a pivot table on sheet
TASK 1 Summary which will need refreshing after the data have been transformed, but remember, it's working on incomplete data.
Power Pivot/Power Query might indeed be able to help you better but I don't know enough about these applications yet to advise you well.
Looking at the data, I strongly suspect that it's already pivoted data from a database; is that database available to you? It seems very likely indeed that querying or pivoting that database directly in Excel would be the lightest and easiest solution.
Attachment sent privately.
