How do i re-format the presentation of large amounts of data?

[jackpollek]

hello,
I am downloading some data from a database to perform panel regression on.
When i download the data it comes in the format shown in rows A1:M10.
However I would like to rearrange the data to the format shown In O1:R28
I will be dealing with large amount of data so am looking for a way to do this quickly.

I hope this question makes sense, I will greatly appreciate any help

Example sheet.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R
1	Year	Firm 1 - EPS	Firm 1 - ESG	Firm 2 - EPS	Firm 2 - ESG	Firm 3 - EPS	Firm 3 - ESG	Firm 4 - EPS	Firm 4 - ESG	Firm 5 - EPS	Firm 5 - ESG	Firm 6 - EPS	Firm 6 - ESG		Firm	Year	EPS	ESG
2	2012	1.579	57.07	1.816	88.35	-0.004	42.63	-0.738	24.12	5.016	74.31	0.225	63.46		Firm 1	2012	1.579	57.07
3	2013	1.446	60.54	2.705	92.34	0.029	45.92	-0.124	27.14	4.88	77.6	0.185	75.87		Firm 1	2013	1.446	60.54
4	2014	1.861	56.78	2.496	92.32	-0.026	49.58	-0.472	28.59	5.046	77.91	0.28	78.31		Firm 1	2014	1.861	56.78
5	2015	2.361	54.18	1.436	92.82	0.062	50.67	-1.386	28.05	4.568	78.83	0.27	74.67		Firm 1	2015	2.361	54.18
6	2016	2.093	61.9	2.128	91.3	0.245	65.59	-0.936	32.81	4.384	77.85	0.642	73.36		Firm 1	2016	2.093	61.9
7	2017	2.563	68.12	3.253	90.72	0.228	72.21	-1.495	38.39	3.21	76.73	1.153	76.62		Firm 1	2017	2.563	68.12
8	2018	2.999	70.01	4.32	93.28	0.992	85.08	-1.145	48.57	2.415	73.93	1.509	75.68		Firm 1	2018	2.999	70.01
9	2019	3.174	70.33	5.741	93	1.15	88.56	-0.974	58.2	5.189	80.31	1.131	74.14		Firm 1	2019	3.174	70.33
10	2020	3.706	76.45	6.713	93.51	2.091	86.89	0.637	63.15	4.745	82.21	1.725	79.19		Firm 1	2020	3.706	76.45
11															Firm 2	2012	1.816	88.35
12															Firm 2	2013	2.705	92.34
13															Firm 2	2014	2.496	92.32
14															Firm 2	2015	1.436	92.82
15															Firm 2	2016	2.128	91.3
16															Firm 2	2017	3.253	90.72
17															Firm 2	2018	4.32	93.28
18															Firm 2	2019	5.741	93
19															Firm 2	2020	6.713	93.51
20															Firm 3	2012	-0.004	42.63
21															Firm 3	2013	0.029	45.92
22															Firm 3	2014	-0.026	49.58
23															Firm 3	2015	0.062	50.67
24															Firm 3	2016	0.245	65.59
25															Firm 3	2017	0.228	72.21
26															Firm 3	2018	0.992	85.08
27															Firm 3	2019	1.15	88.56
28															Firm 3	2020	2.091	86.89
Sheet1

Cells with Data Validation
Cell	Allow	Criteria
A1	Any value

 

[Z51]

This might work for you. Output is in columns O:R like in your example, but you can put it in another range or worksheet. (You'd want to reference sheet names in that case).

Sub jackp()
Dim i As Long, lastrow As Long, lastcol as Long, nextrow As Long, cntRows As Long
lastrow = Range("A" & Rows.Count).End(xlUp).Row
lastcol = Range("A" & lastrow).End(xlToRight).Column
cntRows = lastrow - 1
nextrow = 2

For i = 2 To lastcol Step 2
    Cells(nextrow, "O").Resize(cntRows).Value = Left(Cells(1, i), InStr(1, Cells(1, i), " -") - 1)
    Cells(nextrow, "P").Resize(cntRows).Value = Cells(2, 1).Resize(cntRows).Value
    Cells(nextrow, "Q").Resize(cntRows, 2).Value = Cells(2, i).Resize(cntRows, 2).Value
    nextrow = nextrow + cntRows
Next i

End Sub

 

[johnnyL]

@jackpollek when you say "large amounts of data", how many rows & columns are you talking about?

 

[johnnyL]

No response, so I came up with an alternative approach via Arrays:

Sub FormatData()                                                                    ' 0.0375 average seconds
'
    Dim StartTime           As Double
    StartTime = Timer                                                               ' Start the stopwatch
'
    Dim ArrayColumnNumber   As Long, ArrayRow           As Long
    Dim Counter             As Long
    Dim FirmCount           As Long
    Dim lastrow             As Long
    Dim NumberOfFirms       As Long
    Dim NumberOfYears       As Long
    Dim ResultOffset        As Long
    Dim StartRowOfData      As Long
    Dim Cel                 As Range
    Dim LastColumn          As String
    Dim SourceArray         As Variant, OutputArray()   As Variant
    Dim WS                  As Worksheet
'
    Set WS = Sheets("Sheet1")                                                       ' <--- Set this to the proper sheet name
    StartRowOfData = 2                                                              ' <--- Set this to the row # that the data starts on
    ResultOffset = 2                                                                ' <--- Set this to the # of columns to offset the displayed results
'
    lastrow = WS.Range("A" & WS.Rows.Count).End(xlUp).Row                           ' Get last row # used in Column A
    LastColumn = Split(Cells(1, (WS.Cells.Find("*", , xlFormulas, _
            , xlByColumns, xlPrevious).Column)).Address, "$")(1)                    ' Get last column letter used in sheet
    LastColumnNumber = WS.Cells.Find("*", , xlFormulas, _
            , xlByColumns, xlPrevious).Column                                       ' Get last column number used in sheet
'
    SourceArray = WS.Range("A" & StartRowOfData & ":" & _
            LastColumn & lastrow)                                                   ' Save data into SourceArray
'
    NumberOfFirms = (UBound(SourceArray, 2) - 1) / 2                                ' Determine # of Firms we have
    NumberOfYears = lastrow - StartRowOfData + 1                                    ' Determine how many years we are dealing with
'
    ReDim OutputArray(1 To NumberOfFirms * NumberOfYears, 1 To 4)                   ' Set the # of rows & columns for the OutputArray
'
    Counter = 0                                                                     ' Reset Counter
    For FirmCount = 1 To NumberOfFirms                                              ' Loop through the NumberOfFirms
        For ArrayRow = 1 To NumberOfYears                                           '   Loop through the NumberOfYears
            Counter = Counter + 1                                                   '       Increment Counter
            OutputArray(Counter, 1) = "Firm " & FirmCount                           '       Save the Firm # into OutputArray
            OutputArray(Counter, 2) = SourceArray(ArrayRow, 1)                      '       Save the Year into OutputArray
        Next                                                                        '   Loop back
    Next                                                                            ' Loop back
'
    Counter = 0                                                                     ' Reset Counter
    For ArrayColumnNumber = 2 To UBound(SourceArray, 2) Step 2                      ' Loop through the columns of SourceArray
        For ArrayRow = 1 To NumberOfYears                                           '   Loop through the NumberOfYears
            Counter = Counter + 1                                                   '       Increment Counter
            OutputArray(Counter, 3) = SourceArray(ArrayRow, ArrayColumnNumber)      '       Save the EPS into OutputArray
            OutputArray(Counter, 4) = SourceArray(ArrayRow, ArrayColumnNumber + 1)  '       Save the ESG into OutputArray
        Next                                                                        '   Loop back
    Next                                                                            ' Loop back
'
    WS.Cells(StartRowOfData - 1, LastColumnNumber + ResultOffset).Resize(1, 4) = _
            Array("Firm", "Year", "EPS", "ESG")                                     ' Display Result Headers to sheet
    WS.Cells(StartRowOfData - 1, LastColumnNumber + _
            ResultOffset).Resize(1, 4).Font.FontStyle = "Bold"                      ' Bold the Result Headers
    WS.Cells(StartRowOfData, LastColumnNumber + ResultOffset).Resize(UBound(OutputArray, _
            1), UBound(OutputArray, 2)) = OutputArray                               ' Display results to sheet
'
' Not sure how to no loop this part
    For Each Cel In WS.Range(WS.Cells(StartRowOfData, LastColumnNumber + ResultOffset), _
            WS.Cells(UBound(OutputArray, 1) + 1, LastColumnNumber + ResultOffset))  ' Loop through the 'Firm' column
        If Right(Cel.Value, 1) Mod 2 = 0 Then Cel.Font.Color = 255                  '   Make the cell font red if the firm is an even number
    Next                                                                            ' Loop back
'
    Debug.Print "Time to complete = " & Timer - StartTime & " seconds."             ' Display elapsed time to the 'Immediate' window (CTRL-G) in VBE
    MsgBox "Completed in " & Timer - StartTime & " seconds."                        ' Display message box to user to inform them the script has completed
End Sub

That 'should be' faster.

 

[rlv01]

Sub DoSomething()
    Dim WS As Worksheet
    Dim DataStart As Range, ResultStart As Range, rng As Range
    Dim I As Long, LastRow As Long, RCnt As Long
    Dim S As String
    Dim VA, SA
    
    Set WS = ActiveSheet
    
    Set DataStart = WS.Range("A1")
    Set rng = DataStart.CurrentRegion
    Set ResultStart = DataStart.Offset(0, rng.Columns.Count + 1)
    
    Application.ScreenUpdating = False
    With WS
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    End With
    
    With ResultStart
        .Resize(1, 4).EntireColumn.ClearContents
        .Offset(0, 0).Value = "Firm"
        .Offset(0, 1).Value = "Year"
        .Offset(0, 2).Value = "EPS"
        .Offset(0, 3).Value = "ESG"
    End With
    
    VA = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, 1).Value
    LastRow = 0
    For I = 1 To rng.Columns.Count - 1 Step 2
        With rng.Offset(0, I).Resize(, 2)
            SA = .Offset(1).Value
            S = Trim(Split(.Range("A1").Value, "-")(0))
            RCnt = .Rows.Count
        End With
        
        With ResultStart
            .Offset(LastRow + 1, 0).Resize(RCnt - 1, 1).Value = S
            .Offset(LastRow + 1, 1).Resize(RCnt - 1, 1).Value = VA
            .Offset(LastRow + 1, 2).Resize(RCnt - 1, 2).Value = SA
        End With
        
        With WS
            LastRow = ResultStart.Offset(0, 1).Offset(.Rows.Count - 1).End(xlUp).Row - 1
        End With
    Next I
    Application.ScreenUpdating = True
End Sub

 

[johnnyL]

Sub DoSomething_rlv01_ModV1()                                                       ' Original = 0.0125 average seconds
'                                                                                   ' 0.0199951171875 average seconds w/ added stipulations
'
    Dim StartTime           As Double
    StartTime = Timer                                                               ' Start the stopwatch
'
    Dim I           As Long, LastRow    As Long, RCnt   As Long
    Dim rng         As Range
    Dim S           As String
    Dim VA          As Variant, SA      As Variant
    Dim WS          As Worksheet
'
    Set WS = ActiveSheet                                                            ' <--- Set this to the proper sheet name
'
    Application.ScreenUpdating = False
'
    Set rng = WS.Range("A1").CurrentRegion
'
    With WS.Range("A1").Offset(0, rng.Columns.Count + 1)
        .Resize(1, 4).EntireColumn.ClearContents
        .Resize(1, 4) = Array("Firm", "Year", "EPS", "ESG")
        .Resize(1, 4).Font.FontStyle = "Bold"                                       ' Bold the Result Headers
    End With
'
    VA = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, 1).Value                       ' Load years into VA array
'
    LastRow = 0
    For I = 1 To rng.Columns.Count - 1 Step 2
        With rng.Offset(0, I).Resize(, 2)
            SA = .Offset(1).Value
            S = Trim(Split(.Range("A1").Value, "-")(0))
            RCnt = .Rows.Count
        End With
        
        With WS.Range("A1").Offset(0, rng.Columns.Count + 1)
            .Offset(LastRow + 1, 0).Resize(RCnt - 1, 1).Value = S
            .Offset(LastRow + 1, 1).Resize(RCnt - 1, 1).Value = VA
            .Offset(LastRow + 1, 2).Resize(RCnt - 1, 2).Value = SA
        End With
'
        LastRow = WS.Range("A1").Offset(0, rng.Columns.Count + 1).Offset(0, 1).Offset(WS.Rows.Count - 1).End(xlUp).Row - 1
    Next
'
    For Each Cel In Range("O2:O55")  ' Loop through the 'Firm' column
        If Right(Cel.Value, 1) Mod 2 = 0 Then Cel.Font.Color = 255                  '   Make the cell font red if the firm is an even number
    Next                                                                            ' Loop back
'
    Application.ScreenUpdating = True
'
    Debug.Print "Time to complete = " & Timer - StartTime & " seconds."             ' Display elapsed time to the 'Immediate' window (CTRL-G) in VBE
    MsgBox "Completed in " & Timer - StartTime & " seconds."                        ' Display message box to user to inform them the script has completed
End Sub

 

[jackpollek]

Sub DoSomething()
    Dim WS As Worksheet
    Dim DataStart As Range, ResultStart As Range, rng As Range
    Dim I As Long, LastRow As Long, RCnt As Long
    Dim S As String
    Dim VA, SA
   
    Set WS = ActiveSheet
   
    Set DataStart = WS.Range("A1")
    Set rng = DataStart.CurrentRegion
    Set ResultStart = DataStart.Offset(0, rng.Columns.Count + 1)
   
    Application.ScreenUpdating = False
    With WS
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    End With
   
    With ResultStart
        .Resize(1, 4).EntireColumn.ClearContents
        .Offset(0, 0).Value = "Firm"
        .Offset(0, 1).Value = "Year"
        .Offset(0, 2).Value = "EPS"
        .Offset(0, 3).Value = "ESG"
    End With
   
    VA = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, 1).Value
    LastRow = 0
    For I = 1 To rng.Columns.Count - 1 Step 2
        With rng.Offset(0, I).Resize(, 2)
            SA = .Offset(1).Value
            S = Trim(Split(.Range("A1").Value, "-")(0))
            RCnt = .Rows.Count
        End With
       
        With ResultStart
            .Offset(LastRow + 1, 0).Resize(RCnt - 1, 1).Value = S
            .Offset(LastRow + 1, 1).Resize(RCnt - 1, 1).Value = VA
            .Offset(LastRow + 1, 2).Resize(RCnt - 1, 2).Value = SA
        End With
       
        With WS
            LastRow = ResultStart.Offset(0, 1).Offset(.Rows.Count - 1).End(xlUp).Row - 1
        End With
    Next I
    Application.ScreenUpdating = True
End Sub

Thank you very much for everyone's help! I really appreciate it