Error Checking in Excel
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 10 of 10

Thread: Tranposing with a macro of much painful data

  1. #1
    New Member
    Join Date
    Apr 2002
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

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

  2. #2
    Board Regular
    Join Date
    Feb 2002
    Location
    Essex, England
    Posts
    459
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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



  3. #3
    Rest in Peace
    Join Date
    Feb 2002
    Posts
    1,582
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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


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

  4. #4
    New Member
    Join Date
    Apr 2002
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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!

  5. #5
    Rest in Peace
    Join Date
    Feb 2002
    Posts
    1,582
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hi Habana


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

  6. #6
    New Member
    Join Date
    Apr 2002
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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!

  7. #7
    Board Regular
    Join Date
    Feb 2002
    Location
    Essex, England
    Posts
    459
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default



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

  8. #8
    Board Regular
    Join Date
    Feb 2002
    Location
    Essex, England
    Posts
    459
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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

  9. #9
    Rest in Peace
    Join Date
    Feb 2002
    Posts
    1,582
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hi Habana


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



  10. #10
    New Member
    Join Date
    Apr 2002
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

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

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •