Mass Data Table in to Workable Format!

Hi All,

New to the forum, hoping you'll be able to solve a problem I have been stuck on for weeks!! I have tried google, youtube etc but I don't think i'm able to search the correct terms for what I'm wanting to do... which is how I came across you guys and girls!!

I get this data on a weekly basis from our payroll department (all personal data has been removed from the file for this query).
I'm wanting to make the format cleaner, so I can then use the data for other reports. Currently the table is in a horizontal format, with 70+ headers meaning I have to transpose the headers and then individually look up the 160 employees to get the data in a tabular format, I can use the match or lookup functions, but this means individually changing the lookup row for each employee and can also do the old fashioned copy and paste, but again I would need to repeat this 100's of times to get the data aligned, it's do-able but massively time consuming.

The personal data columns aren't needed, I just need the financial data starting from column T (employers NI) to Column CM (trading bonus)

example of my explanation/idea below;

Current state;

Salary Tax Bonus Car Allowance Pension
Person A X X X X X
Person B X X X X X
Person C X X X X X

Goal


Person A Salary X
Person A Tax X
Person A Bonus X
Person A Car X
Person A Pens X
Person B Salary X

etc...

OR

Person A Salary X
Person B Salary X
Person C Salary X
Person A Tax X

etc.

I am on excel 2013 and if an additional extension was needed I would need approval from IT, so i'm hoping there is something already set up, a formula or a macro that I can do this with.
If this doesn't make sense please let me know and i'll try and put a bit more info together!

Are we looking to extract from 70 + columns (T to CM) where much of the data is blank (if your sample is typical): if no data is present, is this to be ignored for a given personnel number (so information per person is variable) ?

Hi John,

This is the typical format of the sample, there'll be many blank cells unfortunately.

So to answer your question.... which ever would be easiest to reach the goal! Essentially I need the cells with data in to marry up with the personnel number.

I can use the fill blanks function to give a value for each cell therefore making the data consistent for all personnel numbers if that makes the solution easier to achieve and eliminate the variable element.

No point in filling in "dummy" data if you OK with a variable set of information per person.

Sub Get_PData()

Dim inarr()
Dim rng As Range

'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Worksheets("Data").Activate

lastrow = Cells(Rows.Count, 1).End(xlUp).Row
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column

inarr = Range("A1").CurrentRegion

Dim outarr(1 To 10000, 1 To 3)

n = 0

For i = 2 To UBound(inarr, 1)

    pRef = inarr(i, 1)
    
    For j = 20 To 91
    If inarr(i, j) <> 0 Then
        n = n + 1
        outarr(n, 1) = pRef
        outarr(n, 2) = inarr(1, j)
        outarr(n, 3) = inarr(i, j)
    End If
    Next j
    
Next i


Set Destination = Worksheets("Goal").Range("A2")
Destination.Resize(UBound(outarr, 1), UBound(outarr, 2)).Value = outarr



'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    



End Sub

See sheet "Goal"

Originally Posted by JohnTopley

Sub Get_PData()

Dim inarr()
Dim rng As Range

'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Worksheets("Data").Activate

lastrow = Cells(Rows.Count, 1).End(xlUp).Row
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column

inarr = Range("A1").CurrentRegion

Dim outarr(1 To 10000, 1 To 3)

n = 0

For i = 2 To UBound(inarr, 1)

    pRef = inarr(i, 1)
    
    For j = 20 To 91
    If inarr(i, j) <> 0 Then
        n = n + 1
        outarr(n, 1) = pRef
        outarr(n, 2) = inarr(1, j)
        outarr(n, 3) = inarr(i, j)
    End If
    Next j
    
Next i


Set Destination = Worksheets("Goal").Range("A2")
Destination.Resize(UBound(outarr, 1), UBound(outarr, 2)).Value = outarr



'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    



End Sub

See sheet "Goal"

Thank you so SO much!!

I'm assuming with this Macro I can just copy the script in to my macro book and providing the data is aligned it should now run for all the reports in this format?