Convert data to vertical format and insert rows

[stylencia18]

Good morning:

I have thousands of rows of datain the following format:

Date 1 Proc 1 Date 2 Proc 2 Date 3 Proc 3 Date 4 Proc 4 Date 5 Proc 5

2/1/2018

<tbody>
[TD="width: 62, bgcolor: transparent"] 22120
[/TD]
[TD="width: 70, bgcolor: transparent"] 2/2/2018
[/TD]
[TD="width: 62, bgcolor: transparent"] 22121
[/TD]
[TD="width: 70, bgcolor: transparent"] 2/3/2018
[/TD]
[TD="width: 62, bgcolor: transparent"] 22222
[/TD]
[TD="width: 70, bgcolor: transparent"] 2/4/2018
[/TD]
[TD="width: 62, bgcolor: transparent"] 22221
[/TD]
[TD="width: 70, bgcolor: transparent"] 2/5/2018
[/TD]
[TD="width: 62, bgcolor: transparent"] 22220
[/TD]

</tbody>

I need the data to appearthis way:

Date Proc

2/1/2018

<tbody>
[TD="width: 138, bgcolor: transparent"] 22120
[/TD]

[TD="width: 149, bgcolor: transparent"] 2/2/2018
[/TD]
[TD="width: 138, bgcolor: transparent"] 22121
[/TD]

[TD="width: 149, bgcolor: transparent"] 2/3/2018
[/TD]
[TD="width: 138, bgcolor: transparent"] 22222
[/TD]

[TD="width: 149, bgcolor: transparent"] 2/4/2018
[/TD]
[TD="width: 138, bgcolor: transparent"] 22221
[/TD]

</tbody>

Can someone please help me?!I’ve tried the Transpose option but it doesn’t work.

Thank you!!

 

[mumps]

Try:

Sub TransposeData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, lCol As Long, desWS As Worksheet, x As Long, y As Long
    Set desWS = Sheets("Sheet2")
    desWS.Range("A1:B1") = Array("Date", "Proc")
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    For y = 2 To LastRow
        For x = 1 To lCol - 1 Step 2
            desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(, 2) = Cells(y, x).Resize(, 2).Value
        Next x
    Next y
    Application.ScreenUpdating = True
End Sub

The result will be place in Sheet2.

 

[DataBlake]

mumps is much better and efficient than mine, but maybe mine will be easier to comprehend and change for future use.

Sub thingus()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastRow As Long
Dim lastCol As Long
Dim destRow As Long
Dim i As Integer
Dim j As Integer

    
    ' name and create sheets
    Set ws1 = Sheets("sheet1")
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Range("A1").Select
    Set ws2 = ActiveSheet

' define the rows and columns of the sheets
lastRow = ws1.Range("A" & Rows.Count).End(xlUp).Row
lastCol = ws1.Range("A1").SpecialCells(xlCellTypeLastCell).Column
destRow = ws2.Range("A" & Rows.Count).End(xlUp).Row

' 1st loop
' loop through Sheet1 rows
For i = 2 To lastRow

    ' loop through sheet1 column
    For j = 1 To lastCol
    
        ' for every column paste to column a
        destRow = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
        ws2.Range("A" & destRow).Value = ws1.Cells(i, j).Value
        
        

    j = j + 1
    Next j
Next i

' 2nd loop
' loop through Sheet1 rows
For i = 2 To lastRow

    ' loop through sheet1 column
    For j = 2 To lastCol
    
        ' for every column paste to column b
        destRow = ws2.Range("B" & Rows.Count).End(xlUp).Row + 1
        ws2.Range("B" & destRow).Value = ws1.Cells(i, j).Value
        
        

    j = j + 1
    Next j
Next i

' make headers
ws2.Cells(1, 1).Value = "Date"
ws2.Cells(1, 2).Value = "Proc"

End Sub

 

[stylencia18]

Sorry, beginner here. Where do I type this code into excel and how do I run it?

Thanks!

 

[mumps]

Do the following: Save the workbook as a macro-enabled file. This will change its extension to "xlsm". Hold down the ALT key and press the F11 key. This will open the Visual Basic Editor. In the menu at the top click 'Insert' and then click 'Module'. Copy and paste the macro into the empty code window that opens up. Press the F5 key to run the macro. Close the code module window to return to your sheet. There are other quicker ways to run the macro such as assigning it to a button that you would click on your sheet or assigning it to a short cut key.

 

[stylencia18]

I received a run-time error 9: Subscript out of range

Do the following: Save the workbook as a macro-enabled file. This will change its extension to "xlsm". Hold down the ALT key and press the F11 key. This will open the Visual Basic Editor. In the menu at the top click 'Insert' and then click 'Module'. Copy and paste the macro into the empty code window that opens up. Press the F5 key to run the macro. Close the code module window to return to your sheet. There are other quicker ways to run the macro such as assigning it to a button that you would click on your sheet or assigning it to a short cut key.

 

[mumps]

Which line of code was highlighted when you clicked "Debug"? Do you have a sheet named "Sheet2"?

 

[stylencia18]

Ok, this is what I got...no data

Column A says date and Column B says Proc but there's no data

 

[mumps]

I'm not sure what you mean. Do you have a sheet named "Sheet2"? Make sure the sheet that contains your data is the active sheet when you run the macro.

 

[DataBlake]

and for mine make sure your sheet with data is named "Sheet1"
you do not need a sheet2 for mine as it adds it for you