Transpose entire excel document

[caroline1991]

I have a question about transposing colums to rows.

I know that you can copy/paste and insert special and click transpose. But is it possible to transpose an entire excel document, when everything is in one colume, and then somehow notify excel that each time there is an empty cell it has to switch to a new row, when transposing??

I hope this is understandable and someone has a tip or 2

 

[Gary McMaster]

Hi Caroline,

Welcome aboard!

The following VBA sample will do the requested transposition with a couple of conditions.

1. The single column of data is column A
2. There is a single blank cell between the groups in column A

Deviations from the above will require code modification.

The transposition will start in column B and will leave the original data in column A untouched.

In a standard module:

Public Sub Test()

Dim oCell As Range
Dim oTarget As Range
Dim oTranspose As Range

Set oTarget = ActiveSheet.Range("A1:A" & ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row)
Set oTranspose = ActiveSheet.Range("B1")

For Each oCell In oTarget
    If oCell.Value <> "" Then
        oTranspose.Value = oCell.Value
        Set oTranspose = oTranspose.Offset(0, 1)
    Else
        Set oTranspose = oTranspose.Offset(1, ((oTranspose.Column - 2) * -1))
    End If
Next oCell

End Sub

 

[Vanda_a]

Some explanation on this line please..

((oTranspose.Column - 2) * -1))

I tested it. It works so great. The thing is if there are two or three blanks, the code drop two or three rows too.
How to drop a row only if there many blanks?

Am not the poster. Just wanna study. Sorry for the jump in.

Thank you very much

 

[Gary McMaster]

The thing is if there are two or three blanks, the code drop two or three rows too.

That was expected per my condition #2 of post #2. It shouldn't be too difficult to make it deal with multiple blanks either inline or in a seperate procedure.

Set oTranspose = oTranspose.Offset(1, ((oTranspose.Column - 2) * -1))

It is starting the transpose in column B (1 column offset), the "If" clause above had already moved to the next column (another column offset), hence "Column-2". Then multiply by minus 1 to yield negative Column offset and of course a 1 row positive offset.

 

[Vanda_a]

I see it. Thank you very much

 

[Gary McMaster]

Here's a modified sample that should deal with multiple adjacent blank cells:

Public Sub Test2()

Dim oCell As Range
Dim oTarget As Range
Dim oTranspose As Range

Set oTarget = ActiveSheet.Range("A1:A" & ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row)
Set oTranspose = ActiveSheet.Range("B1")

For Each oCell In oTarget

    If oCell.Value = "" And oCell.Offset(1, 0).Value = "" Then
    
    ElseIf oCell.Value <> "" Then
        oTranspose.Value = oCell.Value
        Set oTranspose = oTranspose.Offset(0, 1)
    Else
        Set oTranspose = oTranspose.Offset(1, ((oTranspose.Column - 2) * -1))
    End If
    
Next oCell

End Sub

 

[Vanda_a]

So cool. You are the man.