Transposing Multiple Rows into Stackable Column

krazy08

New Member
Joined
Dec 23, 2014
Messages
6
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]03-558[/TD]
[TD]Erol[/TD]
[/TR]
[TR]
[TD]03-559[/TD]
[TD]Todd[/TD]
[/TR]
</tbody>[/TABLE]

Hello All,

I'm a high beginner at this but I guess I'm a really good researcher because this got me pretty close to what I need. I just need it to run on every sheet and break off when it is done with the last sheet.

[TABLE="width: 500"]
<tbody>[TR]
[TD]03-558[/TD]
[/TR]
[TR]
[TD]Erol[/TD]
[/TR]
[TR]
[TD]03-559[/TD]
[/TR]
[TR]
[TD]Randy[/TD]
[/TR]
</tbody>[/TABLE]

I am working with this code from 'Biocide'. It does the job but it doesn't know when to stop so it keeps crashing my system unless I break it off (Ctrl+Break) and I'm still stuck on the 1st sheet! And many more to go. Apologies, I'm not lazy, I just couldn't think about moving onto the next phase of code till I solved this one.

Any help is appreciated, Thank you!

Code:
Sub TransposetoOneCol()
    Dim InputRange As Range
    Dim OutputCell As Range
    
'*****ENTER THE SOURCE RANGE TO TRANSPOSE*****
    Set InputRange = Sheets("Sheet1").Range("E:G")
    Set OutputCell = Sheets("Sheet1").Range("B1")   'output will begin at this cell and continue down.


'*****DON'T EDIT BELOW THIS LINE*****
    For Each cll In InputRange
        OutputCell.Value = cll.Value
        Set OutputCell = OutputCell.Offset(1, 0)
                    
            
    Next
 
End Sub
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Try this small change.


Code:
Sub TransposetoOneCol()
    Dim InputRange As Range
    Dim OutputCell As Range
    
'*****ENTER THE SOURCE RANGE TO TRANSPOSE*****
    Set InputRange = Sheets("Sheet1").Range("E:G")
    Set OutputCell = Sheets("Sheet1").Range("B1")   'output will begin at this cell and continue down.


'*****DON'T EDIT BELOW THIS LINE*****
    For Each Cll In InputRange
    If Cll.Value = "" Then Exit For
        OutputCell.Value = Cll.Value
        Set OutputCell = OutputCell.Offset(1, 0)
                    
            
    Next
 
End Sub
 
Upvote 0
krazy08,

Welcome to the MrExcel forum.

1. What version of Excel and Windows are you using?

2. Are you using a PC or a Mac?


In Sheet1, what cell contains 03-558, and, what cell contains Erol?
 
Upvote 0
[SOLVED] Wow that was fast guys. I thought I'd have to check a month later for some replies!

Kiernan, Spot on. Works perfect. Those IF/THEN statements are killing me to learn how to use them without getting errors.

hiker95, Ok good points, you're right and I'll keep that all in mind for the next time I post. I can see that all coming into play for more complex works.

Right on guys, stay cool and hopefully I can help someone else in the future too when I get up to speed on this. I only started 3 days ago.
 
Upvote 0
This code should be quicker (you might not notice it unless you have a large amount of data though)...
Code:
Sub RestackTwoColumnsToOne()
  Dim X As Long, DataArray As Variant, OutputArray As Variant
  DataArray = Range("E1:F" & Cells(Rows.Count, "E").End(xlUp).Row)
  ReDim OutputArray(1 To 2 * UBound(DataArray), 1 To 1)
  For X = 1 To UBound(DataArray)
    OutputArray(2 * X - 1, 1) = DataArray(X, 1)
    OutputArray(2 * X, 1) = DataArray(X, 2)
  Next
  Range("B1:B" & UBound(OutputArray)) = OutputArray
End Sub
 
Upvote 0
krazy08,

Thanks for the feedback.

You are very welcome. Glad we could help.

And, come back anytime.
 
Upvote 0
Hey Rick, thanks for answering also. Ok that code you wrote in arrays in crazy complicated. I'm sure it would work but for now I'm keeping it simple. When I get over my fear of arrays I'll definitely try to reverse engineer that ****** you wrote!
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,915
Members
452,366
Latest member
TePunaBloke

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