Transpose cells skipping blanks

  • Thread starter Thread starter ali
  • Start date Start date
A

ali

Hi there,

Could someone help me sort this one out.

I have data in row 1 in 5 cells. lets say

1 2 blank 3 4

now I want to write a macro in which this row is transposed without
blank cell, i.e., with 4 cells:

1

2

3

4

could someone help me please.
 
maybe something like this, just change the references:

range("A1:E1").SpecialCells(xlCellTypeConstants).copy

range("A2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
 
Hi Ali,
just for a starter solution...not quite final! Using array formula.

with ur data on A1:E1

type on A2:
{=(IF($A$1:$E$1<>"",SMALL($A$1:$E$1,ROW(A2)-1),"X"))}

press Ctrl+shft+ent

then copy down to A2.

but i believe macroman can paste also formulas, kinda like that, as u wish..

regards,
driller
 
maybe something like this, just change the references:

range("A1:E1").SpecialCells(xlCellTypeConstants).copy

range("A2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True

--

Gary










- Show quoted text -
Click to expand...

thanks gary.

Another issue is that the list is changing in size all the time.
Sometimes there are 100 elements, sometimes there are 20, etc. Can we
do it by writing a macro.

Thanks

ali
 
Sorry! Ali,

wrong starter from me in figuring out your DATA!
Gary has a good one...

regards,
driller
--
*****
birds of the same feather flock together..birdwise, it''s more worth
knowing the edges rather than focusing in one line! Know the limits and
remember the extents - dive with Jonathan Seagull
 
this may be what you want. you should qualify the ranges, so change the sheet
name to your sheet name.

Sub transpose_data()
Dim lastcol As Long
Dim ws As Worksheet
Set ws = Worksheets("sheet2")

lastcol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
With ws
..Range(.Cells(1, 1), .Cells(1, lastcol)).SpecialCells(xlCellTypeConstants).Copy

..Range("A2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
End With
Application.CutCopyMode = False

End Sub
 
this may be what you want. you should qualify the ranges, so change the sheet
name to your sheet name.

Sub transpose_data()
Dim lastcol As Long
Dim ws As Worksheet
Set ws = Worksheets("sheet2")

lastcol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
With ws
.Range(.Cells(1, 1), .Cells(1, lastcol)).SpecialCells(xlCellTypeConstants).Copy

.Range("A2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
End With
Application.CutCopyMode = False

End Sub

--

Gary








- Show quoted text -
Click to expand...

thanks gary

this eems to be the answer. However having customized the ranges it is
giving the error "subscript out of range". Could you please have a
look at my code:

Dim lastcol As Long
Dim ws As Worksheet
Set ws = Worksheets("sheet10")

lastcol = ws.Cells(18, Columns.Count).End(xlToLeft).Column
With ws
..Range(.Cells(18, 1), .Cells(18,
lastcol)).SpecialCells(xlCellTypeConstants).Copy


..Range("A486").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
End With
Application.CutCopyMode = False

Thanks a lot

ali
 
i got the same thing until i renamed one of my sheets sheet10.

are you sure that's the exact name of the sheet?
 
i got the same thing until i renamed one of my sheets sheet10.

are you sure that's the exact name of the sheet?

--

Gary













- Show quoted text -
Click to expand...

dear Gary

It is so strange. It is working fine for all the sheets in the
workbook except for the one in which it needs to work. In the project
explorer the sheet is named as follows:

sheet10(sheet30)

it seems to be such a strange problem.

I don't know whether I can further be helped?

Thanks a lot anyway. Your code is great and quick.

Thanks

ali
 
use sheet30, not sheet10

it's also the name on the sheet tab

make this sheet the active sheet

in vb, press control-g to show the immediate window, if it isn't already visible

type the following in the immediate window and press enter

?activesheet.name


whatever it returns needs to go into the code on this line
Set ws = Worksheets("sheet30")
 
use sheet30, not sheet10

it's also the name on the sheet tab

make this sheet the active sheet

in vb, press control-g to show the immediate window, if it isn't already visible

type the following in the immediate window and press enter

?activesheet.name

whatever it returns needs to go into the code on this line
Set ws = Worksheets("sheet30")

--

Gary










- Show quoted text -
Click to expand...
 
use sheet30, not sheet10

it's also the name on the sheet tab

make this sheet the active sheet

in vb, press control-g to show the immediate window, if it isn't already visible

type the following in the immediate window and press enter

?activesheet.name

whatever it returns needs to go into the code on this line
Set ws = Worksheets("sheet30")

--

Gary










- Show quoted text -
Click to expand...

hi gary thanks.

can I send the sheet to you by email so that u can check?

Thanks a lot
 
use sheet30, not sheet10

it's also the name on the sheet tab

make this sheet the active sheet

in vb, press control-g to show the immediate window, if it isn't already visible

type the following in the immediate window and press enter

?activesheet.name

whatever it returns needs to go into the code on this line
Set ws = Worksheets("sheet30")

--

Gary










- Show quoted text -
Click to expand...

hi gary

thanks a lot. Problem sorted. Well to a workaround. There were
formulae in the row which I was selecting for transpose. I selected
the row, then pasted it a "values only" and then ran the macro. It did
the trick.

For my curiosity could u kindly let me know if there is a way to avoid
the paste special and work with the formulae row.

Thanks
ali
 
If the data sets are separated by a blank as your example this macro will do the
trick.

The data sets don't have to be same size but must have a blank between sets.

Sub coltorows()
'transpose from one column to rows
'uneven data but a blank in between each set
LastRow = Range("A" & Rows.Count).End(xlUp).Row
rowCount = 1
colCount = 2
For LoopCount = 1 To LastRow
If Range("A" & (rowCount + 1)) = "" Then
colCount = 2
rowCount = rowCount + 1
Rows(rowCount).Delete
Else
Cells(rowCount, colCount) = Range("A" & (rowCount + 1))
colCount = colCount + 1
Rows(rowCount + 1).Delete
End If
Next LoopCount
End Sub


Gord Dibben MS Excel MVP
 
Back
Top