Convert data to vertical format and insert rows

stylencia18

New Member
Joined
Aug 14, 2017
Messages
31
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
22120
2/2/2018
22121
2/3/2018
22222
2/4/2018
22221
2/5/2018
22220

<tbody>
</tbody>



I need the data to appearthis way:

Date Proc
2/1/2018
22120
2/2/2018
22121
2/3/2018
22222
2/4/2018
22221

<tbody>
</tbody>



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

Thank you!!
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Try:
Code:
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.
 
Last edited:
Upvote 0
mumps is much better and efficient than mine, but maybe mine will be easier to comprehend and change for future use.

Code:
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
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
Which line of code was highlighted when you clicked "Debug"? Do you have a sheet named "Sheet2"?
 
Upvote 0
Ok, this is what I got...no data

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

6OpHJp11SXFRm5CiwARNahyuqoiDYpzkXO7JrqTOSczQogk3P6l 6oCPypSOdMkr4Xry3HrdR0EMCGOFQ5HRVevSlycZW6MnG0Hsgm8rdWpX8nV4YUSAAAAABJRU5ErkJggg==
 
Last edited:
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,216,438
Messages
6,130,632
Members
449,584
Latest member
c_clark

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top