Unpivoting a data table and returning the column header value for each cell with a value (VBA)-CodePudding

I'm working with a dataset that has many columns which not all have an associated value. I've been able to find some VBA code to unpivot the data for each row and capture the fixed fields. However, the header for the columns contains specific information regarding the associated value. I need assistance with returning the Column Head value for each field where a value is identified.

My Dataset

Desired Output (Only missing Header / "Account" values

Current VBA I'm using

Sub Tester()
    
    Dim p
    
    'get the unpivoted data as a 2-D array
    p = UnPivotData(Sheets("Sheet1").Range("A1").CurrentRegion, _
                  6, False, False)
                
    With Sheets("Sheet2").Range("A1")
        .CurrentRegion.ClearContents
        .Resize(UBound(p, 1), UBound(p, 2)).Value = p 'populate array to sheet
    End With

End Sub

Function UnPivotData(rngSrc As Range, fixedCols As Long, _
                   Optional AddCategoryColumn As Boolean = True, _
                   Optional IncludeBlanks As Boolean = True)

    Dim nR As Long, nC As Long, data, dOut()
    Dim r As Long, c As Long, rOut As Long, cOut As Long, cat As Long
    Dim outRows As Long, outCols As Long
    
    data = rngSrc.Value 'get the whole table as a 2-D array
    nR = UBound(data, 1) 'how many rows
    nC = UBound(data, 2) 'how many cols

    'calculate the size of the final unpivoted table
    outRows = nR * (nC - fixedCols)
    outCols = fixedCols   IIf(AddCategoryColumn, 2, 1)
    
    'resize the output array
    ReDim dOut(1 To outRows, 1 To outCols)
               
    'populate the header row
    For c = 1 To fixedCols
        dOut(1, c) = data(1, c)
    Next c
    If AddCategoryColumn Then
        dOut(1, fixedCols   1) = "Category"
        dOut(1, fixedCols   2) = "Value"
    Else
        dOut(1, fixedCols   1) = "Value"
    End If

    
    'populate the data
    rOut = 1
    For r = 2 To nR
        For cat = fixedCols   1 To nC
            
            If IncludeBlanks Or Len(data(r, cat)) > 0 Then
                rOut = rOut   1
                'Fixed columns...
                For c = 1 To fixedCols
                    dOut(rOut, c) = data(r, c)
                Next c
                'populate unpivoted values
                If AddCategoryColumn Then
                    dOut(rOut, fixedCols   1) = data(1, cat)
                    dOut(rOut, fixedCols   2) = data(r, cat)
                Else
                    dOut(rOut, fixedCols   1) = data(r, cat)
                End If
            End If
        Next cat
    Next r
    
    UnPivotData = dOut
End Function

CodePudding user response：

UnPivotData has a parameter AddCategoryColumn to which you're passing False - if you instead pass True then you'll get the result you want.