2

I have a large data set consisting of two columns with repeat row names but unique row values. Here is a small example: 

A   1
A   2
A   3
A   4
A   5
A   6
A   7
B   8
B   9
B   10
B   11
B   12
B   13
B   14
C   15
C   16
C   17
C   18
C   19
C   20
C   21

I would like to convert this to a few rows with multiple columns. Like this: 

A   1   2   3   4   5   6   7
B   8   9   10  11  12  13  14
C   15  16  17  18  19  20  21

I tried to record a macro, but I could not figure out how to get the macro to not only select the range of cells from B1:B7 but also from B8:B14 when I click on B8. The macro always reverted to B1:7.

Here is my example macro: 

Sub Macro2()    
Range("B1:B7").Select
Selection.Copy
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub

I have done some extensive googling and could not come up with an easy answer. I apologize if this is rudimentary.

Thank you for your help.

I should have been more specific with how my data looks. Here is an example, but I have many more rows for each row name.

A*01:01 24575.73
A*01:01 66.87
A*01:01 38.21
A*01:01 24532.88
A*01:01 2090.44
A*01:01 61.87
A*01:01 41.01
A*02:01 306.68
A*02:01 24.96
A*02:01 23182.25
A*02:01 28.23
A*02:01 54.94
A*02:01 39.87
A*02:01 22734.92
A*02:03 22.83
A*02:03 131.63
A*02:03 35.51
A*02:03 71.33
A*02:03 30.82
A*02:03 24.21
A*02:03 25.23

Community
  • 1
  • 1
Clinpath
  • 21
  • 1
  • 3
  • Do you need to use a macro to do this repeatedly/in the future, or is this a one-time thing you just need to know how to do in a not-slow way? – Joe Dec 23 '13 at 20:32
  • Thank you for asking. I would be repeatedly doing this in the future. – Clinpath Dec 23 '13 at 20:53
  • Here is a solution that worked really well for me: Re: Formating Data - columns to rows Your example looks pretty "clean", always 7 values per column A value. Is that a good enough "method". If the need is more "dynamic", use this: Here's a macro for merging columns of data to one row matching for column A. There's a sample workbook too you could drop your data into and test it out. http://sites.madrocketscientist.com/jerrybeaucaires-excelassistant/text-functions/column-sets-to-rows It is the Consolidate macro within the linked file on that site. Thank you all for the help! – Clinpath Dec 23 '13 at 22:33
  • Is your data pre-sorted as your initial example implied? – brettdj Dec 24 '13 at 00:42
  • The data is presorted. I used the solution in my previous comment and it worked well for the data. – Clinpath Dec 24 '13 at 20:07

4 Answers4

1

Try somethign like this:

Const DEST_COLUMN As Integer = 5

Sub ByMakah()
    Dim lastRow As Integer, rowIndex As Integer
    Dim name As String, value As String, destionationRow As Integer, destionationCol As Integer

    'Clear Area
    Range("E:AA").ClearContents

    lastRow = Range("A10000").End(xlUp).Row
    Range(Cells(1, 1), Cells(lastRow, 1)).Copy
    Cells(1, DEST_COLUMN).PasteSpecial

    Range(Cells(1, DEST_COLUMN), Cells(lastRow, DEST_COLUMN)).RemoveDuplicates Columns:=1, Header:=xlYes

    'Fill values
    For rowIndex = 2 To lastRow
        name = Cells(rowIndex, 1)
        value = Cells(rowIndex, 2)

        destionationRow = WorksheetFunction.Match(name, Columns(DEST_COLUMN), False)

        'Get lastCol
        destionationCol = Cells(destionationRow, 1000).End(xlToLeft).Column + 1
        Cells(destionationRow, destionationCol) = value
    Next rowIndex

End Sub
Makah
  • 4,435
  • 3
  • 47
  • 68
  • Thank you very much for the help. This was my result when running the above macro: A 2 3 4 5 6 7 A B 8 9 10 11 12 13 14 C 15 16 17 18 19 20 21 – Clinpath Dec 23 '13 at 21:53
1

A Simple Solution would be:

Sub transposer()
    Dim lcell As Range
    Dim c_row  As Integer
    Dim a_cell As String
    Dim c_col As Long
    Sheet1.Columns("A:B").Sort key1:=Sheet1.Range("A2"), order1:=xlAscending, Header:=xlYes
    For Each lcell In Sheet1.Range("$A$1", "$A$" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row)
       If a_cell <> lcell Then
           c_row = c_row + 1
           a_cell = lcell
           Sheet1.Cells(c_row, 3) = a_cell
           c_col = 4
       End If
       Sheet1.Cells(c_row, c_col) = Sheet1.Cells(lcell.Row, 2)
       c_col = c_col + 1
    Next lcell
    Sheet1.Range("A:B").EntireColumn.Delete
End Sub

This assumes there are headers if no headers then 

Sheet1.Columns("A:B").Sort key1:=Sheet1.Range("A2"), order1:=xlAscending, Header:=xlYes

Should be 

Sheet1.Columns("A:B").Sort key1:=Sheet1.Range("A1"), order1:=xlAscending
engineersmnky
  • 25,495
  • 2
  • 36
  • 52
  • 1. I don't like to destroy the resource. 2. I prefer to use Match (order data first). – Makah Dec 23 '13 at 21:28
  • 1
    Added data order no data destruction just transposition from rows to columns then cleanup. Which fits his description of the requested output. I do not like to rely on Worksheet Functions and avoid Constants unless they are truly needed in multiple locations – engineersmnky Dec 23 '13 at 21:34
  • Works great with the example. Can't seem to get it to work with my actual data. I added a more specific example of my data. Thank you again for the help. – Clinpath Dec 23 '13 at 22:09
  • is your data formulated? where are the cells divided? Is `A*01:01` the category and `24575.73` this the data? – engineersmnky Dec 27 '13 at 01:52
  • Can you explain what you mean by "Can't seem to get it to work" because when I test with your data it still works perfectly? Or put up a link to a larger data set so i can test against that. – engineersmnky Dec 27 '13 at 14:29
1

This method uses a variant array to quickly perform the transposing

It works on

  • Columns A&B with this line X = Range([a1], Cells(Rows.Count, "B").End(xlUp))
  • Dumps to C1 with this line [c1].Resize(UBound(X, 1), UBound(X, 1)) = Y

code

Sub ByeSwanny()
Dim X
Dim Y
Dim lngRow As Long
Dim lngCnt1 As Long
Dim lngCnt2 As Long

X = Range([a1], Cells(Rows.Count, "B").End(xlUp))
ReDim Y(1 To UBound(X, 1), 1 To UBound(X, 1))

Y(1, 1) = X(1, 1)
Y(1, 2) = X(1, 2)
lngCnt1 = 2
lngCnt2 = 1

For lngRow = 2 To UBound(X, 1)
If X(lngRow, 1) = X(lngRow - 1, 1) Then
lngCnt1 = lngCnt1 + 1
Y(lngCnt2, lngCnt1) = X(lngRow, 2)
Else
lngCnt1 = 2
lngCnt2 = lngCnt2 + 1
Y(lngCnt2, 1) = X(lngRow, 1)
Y(lngCnt2, 2) = X(lngRow, 2)
End If
Next lngRow

[c1].Resize(UBound(X, 1), UBound(X, 1)) = Y

End Sub

enter image description here

brettdj
  • 54,857
  • 16
  • 114
  • 177
  • great concept assuming that the data sets are not so large that the memory consumption becomes an issue. – engineersmnky Dec 27 '13 at 14:35
  • Tested your method vs mine on ~2,000 Rows CPU usage is similar but memory consumption on my method is ~+1mb vs yours which is ~+ 70mb meaning if his data set is maxing out excel 2007 ~65,0000 rows storing the data in memory may become a concern +1 for the concept though for sure – engineersmnky Dec 27 '13 at 14:43
  • It's the tried and proven method for working with large data ranges in excel - memory won't had an issue . Thx for the Upvore :) – brettdj Dec 27 '13 at 23:33
0

The solution for this is slightly adapted from here (see also this accepted answer). If your source range is A1:B21 (it can be easily extended), and you want your new data to be stored in D1:L3, use the following formulas:

For D1: =INDEX($A$1:$A$50,ROW()*7-6,1)

For E1: =INDEX($B$1:$B$50,ROW()*7-6,1)

For F1: =INDEX($B$1:$B$50,ROW()*7-5,1)

For G1: =INDEX($B$1:$B$50,ROW()*7-4,1)

... and so on for row 1. Then copy from D1:L1 downwards as needed.

The upside of this approach is that it does not use VBA.

The downside is that it uses a fixed number of items for each letter. If that were variable, I conceive that more complex formulas might do the job, and there is a clear way of doing it with VBA.

Community
  • 1
  • 1
sancho.s ReinstateMonicaCellio
  • 14,708
  • 20
  • 93
  • 185
  • 1
    If you change the data a bit it dosen't work anymore. – Makah Dec 23 '13 at 22:01
  • Thank you for this proposed solution. My dataset is quite large, however. – Clinpath Dec 23 '13 at 22:02
  • @Makah - It would be useful if you gave more specific indication about what does "change the data a bit" mean. As posted, I would not be able to understand your comment. Possible changes that I can think of are: 1) Having another number (different from 7 as in this case), but still constant, of rows values per row name; this can be easily fixed by replacing the hardcoded 7. 2) Having a non-constant number of rows values per row name; this case was specifically commented on in the answer. For other "changes a bit" than this, probably the VBA solutions won't work either. – sancho.s ReinstateMonicaCellio Dec 24 '13 at 11:49