Convert horizontal table and data to vertical table

[thedeadzeds]

Hi Guys,

Pretty sure this is impossible but Is there a way to convert the below exported table to something that looks like the table in example 2? The month does not show in the table data but is always in cell AH as the following:

Call month :2023 October

Exported Table

Hour/DAY	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27	28	29	30	31
00:00
01:00
02:00
03:00
04:00
05:00
06:00
07:00
08:00						1																									1
09:00			1		3	2			1	3		1	1			1	1	1							1		1			3	2
10:00	1	1	1	1		1	2	1		1	1	1	3			2	1	5	2		1	3	1		1	2		2	1	2	2
11:00			1	2	1	1	1	1	5	2	3		2	1	2		2		2	3	2	1	3	3	1				1	2	2
12:00		1	1	3	3			1	2		1	2	1	3		2	2	1					1			4	1	2
13:00	1	1	5	1	1		1		3		3		3	1	1	4	1	1	1		1	1		2		2	3			2
14:00	1	1		1	1	1	2	1		1	1	1		1	2		1		3	3			2		4	2	2		3	2	1
15:00		1	1		3	1			4	1	1	1	3	4		3	1		2	1	1	2	1		5	1	1			5	2
16:00		2	2	1	1	1	1		1		1		1	1			1	1	3	2	1		1	1	3	3	2	3		2
17:00		2				3				1			1		1	5	4	1					1	1	3		2				2
18:00																		1			1
19:00
20:00
21:00
22:00
23:00
TOTAL	3​	9​	12​	9​	13​	11​	7​	4​	16​	9​	11​	6​	15​	11​	6​	17​	14​	11​	13​	9​	7​	7​	10​	7​	18​	14​	12​	7​	5​	18​	12​

Example 2

Day	Time	Month	Year	Day Time
1	10:00	October	2023	01/10/2023 10:00​
1	13:00	October	2023	01/10/2023 13:00​
1	14:00	October	2023	01/10/2023 14:00​
2	10:00	October	2023	02/10/2023 10:00​
2	12:00	October	2023	02/10/2023 12:00​
2	13:00	October	2023	02/10/2023 13:00​
2	14:00	October	2023	02/10/2023 14:00​
2	15:00	October	2023	02/10/2023 15:00​
2	16:00	October	2023	02/10/2023 16:00​
2	16:00	October	2023	02/10/2023 16:00​
2	17:00	October	2023	02/10/2023 17:00​
2	17:00	October	2023	02/10/2023 17:00​

 

[Legacy 143009]

Try this:

Sub test()
  Dim i As Long, j As Long, r As Long, c As Long, myRange As Range
  With Worksheets("Sheet1")
  Set myRange = .Range("A1").CurrentRegion
  End With
  j = 1
  With Worksheets("Sheet2")
  For c = 2 To myRange.Columns.Count
    For r = 2 To myRange.Rows.Count - 1
      If myRange.Cells(r, c).Value <> "" Then
        For i = 1 To myRange.Cells(r, c).Value
          .Cells(j, 1).Value = myRange.Cells(1, c).Value
          .Cells(j, 2).Value = myRange.Cells(r, 1).Value
          .Cells(j, 3).Value = MonthName(Month(Worksheets("Sheet1").Range("AH1").Value))
          .Cells(j, 4).Value = Year(Worksheets("Sheet1").Range("AH1").Value)
          .Cells(j, 4).Value = Worksheets("Sheet1").Range("AH1").Value + (myRange.Cells(1, c).Value - 1) + myRange.Cells(r, 1).Value
          j = j + 1
        Next
      End If
    Next
  Next
  End With
End Sub

 

[thedeadzeds]

Thanks for this. I am getting a runtime error on the below at the moment. The data in sheet1 is in A1 to AF26 and 'Call month :2023 October' is in AH1


.Cells(j, 3).Value = MonthName(Month(Worksheets("Sheet1").Range("AH1").Value))

 

[Legacy 143009]

OK, your date is a string then. This should work:

Sub test()
  Dim i As Long, j As Long, r As Long, c As Long, myRange As Range
  Dim myYear As String, myMonth As String
 
  With Worksheets("Sheet1")
  Set myRange = .Range("A1").CurrentRegion
  myMonth = Mid(.Range("AH1"), InStrRev(.Range("AH1"), " ") + 1, Len(.Range("AH1")))
  myYear = Mid(.Range("AH1"), InStrRev(.Range("AH1"), " ") - 4, 4)
  End With
 
  j = 2
  With Worksheets("Sheet2")
  For c = 2 To myRange.Columns.Count
    For r = 2 To myRange.Rows.Count - 1
      If myRange.Cells(r, c).Value <> "" Then
        For i = 1 To myRange.Cells(r, c).Value
          .Cells(j, 1).Value = myRange.Cells(1, c).Value
          .Cells(j, 2).Value = myRange.Cells(r, 1).Value
          .Cells(j, 3).Value = myMonth
          .Cells(j, 4).Value = myYear
          .Cells(j, 4).Value = DateValue(myRange.Cells(1, c).Value & " " & myMonth & " " & myYear) + myRange.Cells(r, 1).Value
          j = j + 1
        Next
      End If
    Next
  Next
  End With
End Sub

 

[thedeadzeds]

This is amazing thank you so much

 

[Legacy 143009]

You are welcome

 

[alansidman]

An alternative to VBA with Power Query

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Hour/DAY", type time}}),
    #"Removed Errors" = Table.RemoveRowsWithErrors(#"Changed Type", {"Hour/DAY"}),
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Removed Errors", {"Hour/DAY"}, "Attribute", "Value"),
    #"Renamed Columns" = Table.RenameColumns(#"Unpivoted Other Columns",{{"Attribute", "Date"}}),
    #"Added Prefix" = Table.TransformColumns(#"Renamed Columns", {{"Date", each "Oct " & _, type text}}),
    #"Sorted Rows" = Table.Sort(#"Added Prefix",{{"Date", Order.Ascending}}),
    #"Added Suffix" = Table.TransformColumns(#"Sorted Rows", {{"Date", each _ & " 2023", type text}}),
    #"Reordered Columns" = Table.ReorderColumns(#"Added Suffix",{"Value", "Hour/DAY", "Date"}),
    #"Merged Columns" = Table.CombineColumns(Table.TransformColumnTypes(#"Reordered Columns", {{"Hour/DAY", type text}}, "en-US"),{"Hour/DAY", "Date"},Combiner.CombineTextByDelimiter(" ", QuoteStyle.None),"Date Time")
in
    #"Merged Columns"