resorting table using array - excel

Question

am trying to resort the data using Code consider the data shape like this :
Empid| 1/01/2019|2/01/2019 | 3/01/2019
-------------------------------------------
1 | A | B | A
2 | B | A | B
3 | B | C | C
4 | A | A | A
and the goal shape like this :
Empid | Date | Shift
---------------------
1 |1/01/2019 | A
1 |2/01/2019 | B
1 |3/01/2019 | A
2 |1/01/2019 | B
2 |2/01/2019 | A
2 |3/01/2019 | B
3 |1/01/2019 | B
3 |2/01/2019 | C
3 |3/01/2019 | C
4 |1/01/2019 | A
4 |2/01/2019 | A
4 |3/01/2019 | A
i used this code and reached to this shape using the code :
Empid | Shift
---------------------
1 |A
1 |B
1 |A
2 |B
2 |A
2 |B
3 |B
3 |C
3 |C
4 |A
4 |A
4 |A
this is the vba code :
Sub TransposeData()
Const FirstDataRow As Long = 2 ' presuming row 1 has headers
Const YearColumn As String = "A" ' change as applicable
Dim Rng As Range
Dim Arr As Variant, Pos As Variant
Dim Rl As Long, Cl As Long
Dim R As Long, C As Long
Dim i As Long
With ActiveSheet
Cl = .UsedRange.Columns.Count - .UsedRange.Column + 1
Rl = .Cells(.Rows.Count, Columns(YearColumn).Column).End(xlUp).Row
Set Rng = Range(.Cells(FirstDataRow, YearColumn), .Cells(Rl, Cl))
End With
Arr = Rng.Value
ReDim Pos(1 To (UBound(Arr) * UBound(Arr, 2)), 1 To 2)
For R = 1 To UBound(Arr)
For C = 2 To UBound(Arr, 2)
i = i + 1
Pos(i, 1) = Arr(R, 1)
Pos(i, 2) = Arr(R, C)
Next C
Next R
R = Rl + 5 ' write 5 rows below existing data
Set Rng = ActiveSheet.Cells(R, YearColumn).Resize(i, 2)
Rng.Value = Pos
End Sub

Answer 1

Use Power Query (aka Get & Transform in Excel 2016+).
Select the first column and UNpivot the other columns.
Rename the resultant Date column (which will be named Attributes by the GUI), and the Shift column (which will be named Value by the GUI).
If you want to do this in VBA, record a macro while running PQ
With a single cell selected in your table, select Get & Transform from Table/Range
Power Query will open. Ensure you have selected the first column. Then, from Transform, select the dropdown next to the Unpivot button. From that dropdown, select unpivot other columns.
After selecting that, you will see that you need to rename columns 2 and 3
After that, select one of the Close options from the File menu, and load the results to either the same sheet or another sheet.
Now you can rerun the query if your data changes.
And, as I wrote above, if you need to do this using VBA, just record a macro while you go through the steps.
I also suggest you search SO for unpivot and you'll get a lot of information.

Answer 2

Array Approach
Option Explicit
Public Sub Rearrange()
Dim t#: t = timer ' stop watch
Dim ws As Worksheet ' worksheet object
Set ws = ThisWorkbook.Worksheets("Sheet3") ' << change to sheet name
Const STARTCOL = "A" ' << change to your needs
' [1] get last row in column A
Dim r&, c& ' used rows/cols (assuming no blanks)
r = ws.Range(STARTCOL & ws.Rows.count).End(xlUp).Row
c = ws.Columns(STARTCOL).End(xlToRight).Column - ws.Columns(STARTCOL).Column
' [2] get values to 1-based 2-dim variant arrays
Dim tmp, tgt
tmp = ws.Range(ws.Cells(1, STARTCOL), ws.Cells(r, c + 1)).Value2
ReDim tgt(1 To c * (UBound(tmp) - 1) + 1, 1 To c) ' resize target array
' [3] rearrange data in target array
Dim i&, ii&, j&
For i = 2 To UBound(tmp)
For j = 2 To UBound(tmp, 2) ' get row data
ii = (i - 1) * c + j - c ' calculate new row index
tgt(ii, 1) = tmp(i, 1) ' get ID
tgt(ii, 2) = tmp(1, j) ' get date
tgt(ii, 3) = tmp(i, j) ' get inditgtidual column data
Next j
Next i
tgt(1, 1) = "EmpId": tgt(1, 2) = "Date": tgt(1, 3) = "Shift" ' get captions
' [4] write target array back wherever you want it to ' << redefine OFFSET
ws.Range("A1").Offset(0, c + 2).Resize(UBound(tgt, 1), UBound(tgt, 2)) = tgt
MsgBox "Time needed: " & Format(timer - t, "0.00") & " seconds."
End Sub
Note
You should format the target range with your preferred date formatting, e.g. "dd/mm/yyyy;#" .