Tranposing with a macro of much painful data

[Habana]

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!!

[GaryB]

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

[Dave Hawley]

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

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


[ This Message was edited by: Dave Hawley on 2002-04-08 02:41 ]

[Habana]

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!

[Dave Hawley]

Hi Habana


Always a pleasure to help someone that takes the time to say thanks!

[Habana]

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!

[GaryB]

[ This Message was edited by: garyB on 2002-04-09 05:24 ]

[GaryB]

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

[Dave Hawley]

Hi Habana


Why not just sort a copy of you data by the row header Column before running the code?

[Habana]

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