Another approach is to take the INPUT and process it to a pivot table-friendly format
Capture.JPG
Not sure of some of your business rules, and I think some of your test data as formulas were incorrect
Option Explicit
Dim rowOut As Long
Dim wsIn As Worksheet, wsTemp As Worksheet
Sub PrepareForPivotTable()
Application.ScreenUpdating = False
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Temp").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Worksheets.Add.Name = "Temp"
Set wsTemp = Worksheets("Temp")
Set wsIn = Worksheets("INPUT")
rowOut = 1
With wsTemp
.Cells(rowOut, 1).Value = "Code" ' e.g. RB515
.Cells(rowOut, 2).Value = "Category" ' e.g. OS
.Cells(rowOut, 3).Value = "Account" ' e.g. WML
.Cells(rowOut, 4).Value = "Qty" ' e.g. 180
End With
rowOut = rowOut + 1
Call pvtList("OS", wsIn.Range("B:J"))
Call pvtList("GRN", wsIn.Range("K:S"))
Call pvtList("WMS", wsIn.Range("T:AB"))
Call pvtList("LGRN ", wsIn.Range("AC:AK"))
Call pvtList("CS", wsIn.Range("AL:AT"))
Call pvtList("TRANSFERS", wsIn.Range("AU:BN"))
wsTemp.Cells(1, 1).CurrentRegion.Name = "Data"
Application.ScreenUpdating = True
End Sub
Private Sub pvtList(Cat As String, R As Range)
Dim r1 As Range
Dim iRow As Long, iCol As Long
Dim rowCell As Long, colCell As Long
Dim v As Variant
Set r1 = Intersect(R, wsIn.UsedRange)
With r1
For iRow = 3 To .Rows.Count
For iCol = 1 To .Columns.Count
If .Cells(iRow, iCol).Value > 0 Then
rowCell = .Cells(iRow, iCol).Row
colCell = .Cells(iRow, iCol).Column
wsTemp.Cells(rowOut, 1).Value = wsIn.Cells(rowCell, 1).Value ' code
If Cat = "TRANSFERS" Then
v = Split(wsIn.Cells(2, colCell).Value, ">")
wsTemp.Cells(rowOut, 2).Value = "TRANS" ' category
wsTemp.Cells(rowOut, 3).Value = v(1) ' account
Else
wsTemp.Cells(rowOut, 2).Value = Cat ' category
wsTemp.Cells(rowOut, 3).Value = wsIn.Cells(2, colCell).Value ' account
End If
wsTemp.Cells(rowOut, 4).Value = wsIn.Cells(rowCell, colCell).Value ' qty
rowOut = rowOut + 1
End If
Next iCol
Next iRow
End With
End Sub