Transpose rows to columns on irregular and inconsistent data

Question

I have to transpose rows to columns in excel using vba and the data is of around 500000.

The problem is that the data is not regular and is consistent. Like there will be 4 rows then a blank then it can be three rows or one as well. I want to transpose the group of data separated by a blank cell to be transposed to the the respective column in-front of the first entry.

Sub Transpose()
    ' Transpose Macro
    ' Keyboard Shortcut: Ctrl+Shift+T
    Do Until IsEmpty(ActiveCell.Value)
        Range(Selection, Selection.End(xlDown)).Select

        Application.CutCopyMode = False

        Selection.Copy

        ActiveCell.Offset(0, 1).Range("A1").Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=   _
          False, Transpose:=True

        ActiveCell.Offset(0, -1).Range("A1").Select

        Selection.End(xlDown).Select
        Selection.End(xlDown).Select
    Loop
End Sub

I used this code but the problem is that it is skipping the data which is present in the single row.

You are trying to transpose rows into columns on the same sheet? Won't that mix your data?? — Damian, May 23 '19 at 06:07
actually i want a code that will: 1.read the cell and if it finds any value it should paste it in the next column then it will move one row down and if it finds any value it should paste it in-front of the first row but in different column . 2. It should keep on repeating itself till it finds a blank cell. 3. it should skip the blank cell and then repeat the whole process again till it finds any blank cell. — Abhijeet Singh, May 23 '19 at 06:15
Repeat the whole process after finding a blank cell and jump 1 row on the tranpose, right? — Damian, May 23 '19 at 06:23
after finding a blank cell it should skip to next cell and should transpose it to the next row but in different column then move to next cell and so on — Abhijeet Singh, May 23 '19 at 06:25
Shouldn't the macro start on the first column in the process of transposing? I mean if you start transposing on column E, you went to H and found a blank cell. Where should the macro transpose next? To column E? — Damian, May 23 '19 at 06:27
You might benefit from reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). — Pᴇʜ, May 23 '19 at 06:46

score 0 · Answer 1 · answered May 23 '19 at 06:44

Then this should do it, beware that I'm assuming where your data is and where is going to get paste, don't forget to change that:

Option Explicit
Sub Transpose()

    Dim LastRow As Long 'last row on the sheet
    Dim TransposeRow As Long 'row where we transpose
    Dim x As Long 'columns
    Dim C As Range 'faster looping through cells with For Each C in range

    With ThisWorkbook.Sheets("MySheet") 'change this to your sheet
        'To assign the last row im gonna assume your data is in column A or 1(B would be 2 and so...)
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'Last row with data
        TransposeRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1 'on column B will be pasting the data
        x = 2 'initialize x being 2 as for B column
        For Each C In .Range("A2:A" & LastRow)
            If C = vbNullString Then 'in case the cell is blank we jump a row
                TransposeRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1 ' recalculate row for transposing data
                x = 2 'reinitialize column counter
            Else
                .Cells(TransposeRow, x) = C 'we copy the value to the row and column empty
                x = x + 1 'add 1 column
            End If
        Next C
    End With

End Sub

shrivallabha.redij · Answer 2 · 2019-05-23T07:03:40.803

I have edited your code to show an approach that can work for you. You need to add a condition for one cell data.

Sub Transpose2()
' Transpose Macro
' Keyboard Shortcut: Ctrl+Shift+T
Do Until IsEmpty(ActiveCell.Value)
    If IsEmpty(ActiveCell.Offset(1, 0).Value) Then
        Selection.Copy
        ActiveCell.Offset(0, 1).Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        ActiveCell.Offset(0, -1).Range("A1").Select
    Else
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        ActiveCell.Offset(0, 1).Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        ActiveCell.Offset(0, -1).Range("A1").Select
        Selection.End(xlDown).Select
    End If
    Application.CutCopyMode = False
    Selection.End(xlDown).Select
 Loop
End Sub

Note: Using select is not generally a good idea. An example of cutting down select would be:

Sub Transpose3()
' Transpose Macro
' Keyboard Shortcut: Ctrl+Shift+T
Do Until IsEmpty(ActiveCell.Value)
    If IsEmpty(ActiveCell.Offset(1, 0).Value) Then
        ActiveCell.Copy ActiveCell.Offset(0, 1)
    Else
        Range(ActiveCell, ActiveCell.End(xlDown)).Copy
        ActiveCell.Offset(0, 1).Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        ActiveCell.Offset(0, -1).Range("A1").End(xlDown).Select
    End If
    Application.CutCopyMode = False
    Selection.End(xlDown).Select
 Loop
End Sub

If we are trying to help people with VBA we shouldn't be giving answer with bad practices such as Select. — Damian, May 23 '19 at 06:57
@Damian I have already put a note. I don't see a need to give knee-jerk reaction to down-vote an approach that helps user in understanding approach to solve their own problems [edit] and as I see it user's code relies on current selection whereas yours is hard-coded. User might be using the same macro in different cases! [edit]. — shrivallabha.redij, May 23 '19 at 06:59

Transpose rows to columns on irregular and inconsistent data

2 Answers2