Inserting values from only certain columns to rows

[CKings]

Hi,
I'm helping a friend out with her Excel issue and I don't have the answer either. Maybe someone else has an idea. We have an employee data file where employees are allocated to different legal entities. We are doing an analysis on FTE and for this, we need to insert allocations listed in columns into rows in order to complete our analysis. A pivot wouldn't work regarding other analysis we have to do.

The spreadsheet is as follow:
Row 1: column titles
Row 2: data as presented in the extract we have to work in. Here you see that "Cost FTE" is 1 and .5 of this is allocated to Company A and .5 to Company B.
Row 3+4: this is how we would like to bring in the data ideally: each allocation into a new row without adding the first name more than once. Row 2 can be deleted. Biggest issue is that the number of allocations can differ. Sometimes it's just one company, sometimes up to 8.

Would there be a solution? Currently, this is a manual and error-prone process.

Thank you!

Legal entity – allocated

Employee number

First name

Last name

Cost FTE

Category

Job Family

Legal entity – allocated (1)

Allocation % (1)

Legal entity – allocated (2)

Allocation % (2)

Legal entity – allocated (3)

Allocation % (3)

Company A

ABC123

John

Doe

1​

Employee

Sales

Company A

0.5​

Company B

0.5​

Company A

ABC123

John

Doe

0.5​

Employee

Sales

Company B

ABC123

0

Doe

0.5​

Employee

Sales

 

[maabadi]

Welcome to MrExcel Message Board. Please upload your Example file & Also Desired Result at Different Sheet with XL2BB ADDIN (Preferable) Or upload at Free Hosting site e.g. www.dropbox.com or google drive or OneDrive and Insert Link here.

 

[CKings]

Information to add:
The current spreadsheet is as follow:

Legal entity – allocated	Employee number	First name	Last name	Cost FTE	Category	Job Family	Legal entity – allocated (1)	Allocation % (1)	Legal entity – allocated (2)	Allocation % (2)	Legal entity – allocated (3)	Allocation % (3)	Legal entity – allocated (4)	Allocation % (4)	Legal entity – allocated (5)	Allocation % (5)	Legal entity – allocated (6)	Allocation % (6)	Legal entity – allocated (7)	Allocation % (7)	Legal entity – allocated (8)
Company A	ABC123	John	Doe	1	Employee	Sales	Company A	0.5	Company B	0.5
Company A	ABC124	Jane	Smith	1	Employee	Finance	Company A	0.5	Company B	0.2	Company C	0.3
Company B	ABC125	Ken	Black	1	Employee	Sales	Company B	0.8	Company C	0.2

And this is how it should look like:

Legal entity – allocated	Employee number	First name	Last name	Cost FTE	Category	Job Family	Legal entity – allocated (1)	Allocation % (1)
Company A	ABC123	John	Doe	0.5	Employee	Sales
Company B	ABC123	John	Doe	0.5	Employee	Sales
Company A	ABC124	Jane	Smith	0.5	Employee	Finance
Company B	ABC124	Jane	Smith	0.2	Employee	Finance
Company C	ABC124	Jane	Smith	0.3	Employee	Finance
Company B	ABC125	Ken	Black	0.8	Employee	Sales
Company C	ABC125	Ken	Black	0.2	Employee	Sales

 

[maabadi]

Try this:
I suppose your Data start at Cell A1 at Sheet1. You can See Result at Sheet2

Sub ArrangeData()
Dim Lr As Long, Lr2 As Long, i As Long, j As Long, Ws As Worksheet, Ws2 As Worksheet, a As Long, Lc As Long
Dim b As Long, c As Long, d As Long
Set Ws = Sheets("Sheet1")
Set Ws2 = Sheets("Sheet2")

Lr = Ws.Cells(Rows.Count, 1).End(xlUp).Row
d = 0

For i = 2 To Lr
Lc = Ws.Cells(i, Columns.Count).End(xlToLeft).Column
b = (Lc - 7) / 2
For j = 1 To 7
Ws2.Cells(1, j).Value = Ws.Cells(1, j).Value
For c = 1 To b
If j = 1 Then
Ws2.Cells(d + c + 1, j).Value = Ws.Cells(i, 6 + 2 * c).Value
ElseIf j = 5 Then
Ws2.Cells(d + c + 1, j).Value = Ws.Cells(i, 7 + 2 * c).Value
Else
Ws2.Cells(d + c + 1, j).Value = Ws.Cells(i, j).Value
End If
Next c
Next j
d = d + b
Next i

End Sub

 

[CKings]

Try this:
I suppose your Data start at Cell A1 at Sheet1. You can See Result at Sheet2

Sub ArrangeData()
Dim Lr As Long, Lr2 As Long, i As Long, j As Long, Ws As Worksheet, Ws2 As Worksheet, a As Long, Lc As Long
Dim b As Long, c As Long, d As Long
Set Ws = Sheets("Sheet1")
Set Ws2 = Sheets("Sheet2")

Lr = Ws.Cells(Rows.Count, 1).End(xlUp).Row
d = 0

For i = 2 To Lr
Lc = Ws.Cells(i, Columns.Count).End(xlToLeft).Column
b = (Lc - 7) / 2
For j = 1 To 7
Ws2.Cells(1, j).Value = Ws.Cells(1, j).Value
For c = 1 To b
If j = 1 Then
Ws2.Cells(d + c + 1, j).Value = Ws.Cells(i, 6 + 2 * c).Value
ElseIf j = 5 Then
Ws2.Cells(d + c + 1, j).Value = Ws.Cells(i, 7 + 2 * c).Value
Else
Ws2.Cells(d + c + 1, j).Value = Ws.Cells(i, j).Value
End If
Next c
Next j
d = d + b
Next i

End Sub

Thank you it works! Just a question this was a simplified example of the file I use. The "real" one has ~3000 rows and many more columns (up to AN). Is there a way I can easy expand the code to apply this to the whole file? Due to data privacy, I'm not able to share this.

 

[maabadi]

This Code work on Total file that you used also. Because i input Lastrow (Lr) based last row have data at your Sheet1 Column A. Go Save as your main file and test macro on it. then if you see errors or problem, report it.
if your structure of your main file is different, take example with exact column name until I change macro.