Tranposing with a macro of much painful data

Habana

New Member
Joined
Apr 6, 2002
Messages
4
G'day,

I am a geology student in Melbourne, Australia and I am having a stack of problems with a large data set and transposing it. Basically I need to transpose data from a column to a row. Easy, accept that I have to do it for a few thousand entries and the line the data is transposed to depends on another cells value. For example my data looks like this

0 232
0 564
0 545
50 343
50 984
50 364
100 323
100 343
100 656

and I need it so that all the values for either a 0, 50, or 100 are tranposed onto a separate line...so I need it to look like this

232 564 545 <--- 0 values
343 984 364 <--- 50 values
323 343 656 <--- 100 values

Now, I can't do this manually cos I have about 5000 individual entries. The column with the 0's, 50's, 100's is all in order, it ranges from 0 to 2800 in intervals of 50's...so we have 0, 50, 100, 150....2750, 2800. Each "interval" has a varying number of entries....if that makes sense...I've tried using the old TRANSPOSE(range) CTRL-SHIFT-ENTER thing in a spreadsheet and in macro, but being inept at all things excel I am buggered. Could you give us a hint or something as to how I might write a VBA macro doova whackie that could help me out!! I'm desperate!!
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
It's probably not the best way of doing this and one of the gurus out there may well know a two line code that will do the same thing, but I think this will achieve what you want...


Sub Macro1()
'
' Macro1 Macro
' Macro recorded 08/04/02 by GaryB
'

myrow1 = 2
myrow2 = 1
mycolumn = 2

Sheets(2).Cells(myrow2, 1) = Sheets(1).Cells(1, 2)

Do Until Cells(myrow1, 1) = ""

If Cells(myrow1, 1) = Cells(myrow1 - 1, 1) Then
Sheets(2).Cells(myrow2, mycolumn) = Sheets(1).Cells(myrow1, 2)
myrow1 = myrow1 + 1
mycolumn = mycolumn + 1
Else
myrow2 = myrow2 + 1
mycolumn = 2
Sheets(2).Cells(myrow2, 1) = Sheets(1).Cells(myrow1, 2)
myrow1 = myrow1 + 1

End If


Loop
'
End Sub

You'll need a blank Sheet2 for it to copy your data into

HTH

GaryB
 
Upvote 0
Hi Habana

This code assumes:

1. your 0, 50 and 100 row headings are in Column "A" and A1 IS a heading.

2. The data you want Transposed is in Column "B" and B1 IS a heading.

3. Columns "C" and "D" are empty


Code:
Sub AutoTranspose()
Dim MyData As Range, i As Integer

Set MyData = Range("B2", Range("B65536").End(xlUp))
    Range("A1", Range("A65536").End(xlUp)).AdvancedFilter _
                        xlFilterCopy, , Range("C1"), True


MyData.Cells(1, 1).AutoFilter

For i = 2 To WorksheetFunction.CountA(Columns(3))
  MyData.AutoFilter Field:=1, Criteria1:=Cells(i, 3)
  MyData.SpecialCells(xlCellTypeVisible).Copy
  Cells(i, 4).PasteSpecial Transpose:=True
  Application.CutCopyMode = False
Next i

ActiveSheet.ShowAllData
End Sub


_________________
Kind Regards
Dave Hawley
OzGrid Business Applications
Microsoft Excel/VBA Training
OzGrid.BusApp.170x45.gif

This message was edited by Dave Hawley on 2002-04-08 02:41
 
Upvote 0
Thanks GaryB and Dave :) You guys are champions!! That is great! I really appreciate the effort!! I'm stoked now!!! I'll have to learn this VB stuff cos it really is useful! Thanks again!!! You guys are tops! :)
 
Upvote 0
Doh! I really hate to do this guys but I've come across another problem, I've been using your code Dave but I need to make a small change instead of the data looking the way I said in the original post I now need it to look like this instead

323 343 656 <--- 100 values
343 984 364 <--- 50 values
232 564 545 <--- 0 values

So a mirror image essentially. I tried mucking around with the cell ranges etc...you know, trying to reverse them but everything I try seems to get stuck on the
Cells(i, 4).PasteSpecial Transpose:=True
line and I'm not sure why. Again any help would be greatly appreciated!
 
Upvote 0
Habana,

on my version of events all you'd need to do would be sort your original data decending instead of ascending (revised Macro below). With Dave's you could sort his output using column C descending.

Anyway, here's my code again, but with the sort built onto the front, and an index line added to show what line is for 5,10 etc.

This assumes that your data starts in A1 on Sheet1 and is headerless




Sub Macro1()

myrow1 = 2
myrow2 = 1
mycolumn = 3

Range("A1").Select
Selection.CurrentRegion.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select

Sheets(2).Cells(myrow2, 1) = Sheets(1).Cells(1, 1)
Sheets(2).Cells(myrow2, 2) = Sheets(1).Cells(1, 2)

Do Until Cells(myrow1, 1) = ""

If Cells(myrow1, 1) = Cells(myrow1 - 1, 1) Then
Sheets(2).Cells(myrow2, mycolumn) = Sheets(1).Cells(myrow1, 2)
myrow1 = myrow1 + 1
mycolumn = mycolumn + 1
Else
myrow2 = myrow2 + 1
mycolumn = 3
Sheets(2).Cells(myrow2, 1) = Sheets(1).Cells(myrow1, 1)
Sheets(2).Cells(myrow2, 2) = Sheets(1).Cells(myrow1, 2)
myrow1 = myrow1 + 1
End If


Loop

'
End Sub



Cheers

GaryB
 
Upvote 0
OK, cool! I just sorted the data like you said which solved the problem! Again thanks for your help guys! Much appreciated! :)
 
Upvote 0

Forum statistics

Threads
1,213,484
Messages
6,113,924
Members
448,533
Latest member
thietbibeboiwasaco

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