Transposing multiple columns into one column while repeating the names

[winfy]

Hi all,

I tried everything and got no where...I hope someone can help me.

I have the following data format.

Name Stage 1 Stage 2 Stage 3
John Hall 10 20 30
Alice Bao 15 23 35

I would like it in the following format.

John Hall Stage 1 10
John Hall Stage 2 20
John Hall Stage 3 30
Alice Bao Stage 1 15
Alice Bao Stage 2 23
Alice Bao Stage 3 35


Open to both VBA or excel functions.

Thanks in advance.

Winfy

[fb7894]

formulas would be extremely complicated. here is vba code..

Sub TransposeMe()
    Dim SourceRange As Range
    Dim DestRange As Range
    
    Set SourceRange = Range("A2")
    Set DestRange = Range("A10")
    
    Do Until SourceRange = vbNullString
        With DestRange
            .Value = SourceRange
            .Offset(, 1).Value = "Source 1"
            .Offset(, 2).Value = SourceRange.Offset(, 1)
            .Offset(1, 0).Value = SourceRange
            .Offset(1, 1).Value = "Source 2"
            .Offset(1, 2).Value = SourceRange.Offset(, 2)
            .Offset(2, 0).Value = SourceRange
            .Offset(2, 1).Value = "Source 3"
            .Offset(2, 2).Value = SourceRange.Offset(, 3)
            Set SourceRange = SourceRange.Offset(1)
            Set DestRange = DestRange.Offset(3)
        End With
    Loop
End Sub

[mancubus]

array solution.
this may be quicker for large data sets

Sub vbax_56911_transpose_multi_col()

    Dim NameCount As Long, i As Long, j As Long, k As Long
    Dim ArrTrns
    
    With Worksheets("Sheet1")
        NameCount = Application.CountA(.UsedRange.Columns(1).Offset(1)) 'Offset 1 row to exclude header
        ReDim ArrTrns(1 To NameCount * 3, 1 To 3) '*3 to include 3 stages for each name
        For i = 1 To NameCount
            For j = 2 To 4
                k = k + 1
                ArrTrns(k, 1) = .Cells(i + 1, 1)
                ArrTrns(k, 2) = .Cells(1, j)
                ArrTrns(k, 3) = .Cells(i + 1, j)
            Next j
        Next i
    End With
    
    Worksheets("Sheet2").Cells(1).Resize(UBound(ArrTrns, 1), UBound(ArrTrns, 2)) = ArrTrns

End Sub

[winfy]

Hi fb7984,
Thanks so much for your response. I am wondering if you can show me how to extend the code for many more rows and columns. What I showed you is just a sample of a dataset of 500 rows and 10 columns.

Thanks in advance!

Winfy

[winfy]

Thanks Mancubus,
I
I am not infront of the computer now. I will try your code when I get a chance! Is it scale-able as it is? I can't see it being so, but that could just be my low coding skills.

[mancubus]

you are welcome.

to give you an idea;
it took 24,2 seconds to execute the code with 250000 rows of data (desired result 750000 rows) on my win10 64bit, office 2016 32bit, toshiba satellite p855-32f machine.

[mancubus]

Hi Mancubus,

thanks for your second reply. As I am very new, I don't see where I put the row and column indicator to tell vba where to start and finish with the raw data table.

how does the code repeat the names as well?

i hope to hear from you soon.

winfy

[mancubus]

taking into account the 'given' my code assumes you have a normal excel table.
(it means table's topleft cell is A1, Row 1 is the header row, Row 1 and Column 1 of the table contain no blank cells.)

we know that your input table has 4 columns.

the variable NameCount finds the number of the names in column A via CountA function. (CountA function counts the non-blank cells in specified range.)

in this specific case this range is the first column of the sheet's usedrange, offsetted by one row to exclude the header.

one important point is that normal excel data sheets contain only one table. if you have more than 1 table in your sheet separated by blank columns or rows then my code needs a modification.

you have 3 stages for each name. so NameCount * 3 is the total number of the rows needed.

in the output table, you want;
- names in the first column (taken from Column A or Column 1 in the input table),
- 3 stage names in second column (taken from Range B1-C1-D1 in the input table,
- stage data in the third column (taken from Columns B-C-D or Columns 2-3-4 in the input table).

after declaring a variant variable ArrTrns, it is redimensioned to have NameCount * 3 1st dimension elements (lets say 'rows') and 3 2nd dimension elements (lets say 'columns') with

ReDim ArrTrns(1 To NameCount * 3, 1 To 3)

the 2 loops after this populate the array with values from cells whose row indicator is variable i and column indicator is variable j. i + 1 is used to skip the header (first) row.

i loops names from 1 to NameCount, j loops the stages from 2 to 4. k is the first dimension or row indicatior of the array. it increments by 1 at each loop of j.

i recommend you practice the basics of the vba. take class or online training, buy a vba book, etc.

[mancubus]

modified code for a sheet which contains multiple tables.

Sub vbax_56911_transpose_multi_col()

    Dim NameCount As Long, i As Long, j As Long, k As Long
    Dim ArrTrns
    
    With Worksheets("Sheet1")
        NameCount = Application.CountA(.Cells(1).CurrentRegion.Columns(1).Offset(1)) 'Offset 1 row to exclude header
        ReDim ArrTrns(1 To NameCount * 3, 1 To 3) '*3 to include 3 stages for each name
        For i = 1 To NameCount
            For j = 2 To 4
                k = k + 1
                ArrTrns(k, 1) = .Cells(i + 1, 1)
                ArrTrns(k, 2) = .Cells(1, j)
                ArrTrns(k, 3) = .Cells(i + 1, j)
            Next j
        Next i
    End With
    
    With Worksheets("Sheet2")
        .Cells(1).CurrentRegion.Clear 'clear existing data
        .Cells(1).Resize(UBound(ArrTrns, 1), UBound(ArrTrns, 2)) = ArrTrns
    End With

End Sub

[mancubus]

i attach the file i used for testing to give an idea.
code execution time included here.

Sub vbax_56911_transpose_multi_col_timer()

    Dim NameCount As Long, i As Long, j As Long, k As Long
    Dim ArrTrns
    Dim StartTime As Double
    
    StartTime = Timer
    
    With Worksheets("Sheet1")
        NameCount = Application.CountA(.Cells(1).CurrentRegion.Columns(1).Offset(1)) 'Offset 1 row to exclude header
        ReDim ArrTrns(1 To NameCount * 3, 1 To 3) '*3 to include 3 stages for each name
        For i = 1 To NameCount
            For j = 2 To 4
                k = k + 1
                ArrTrns(k, 1) = .Cells(i + 1, 1)
                ArrTrns(k, 2) = .Cells(1, j)
                ArrTrns(k, 3) = .Cells(i + 1, j)
            Next j
        Next i
    End With
    
    With Worksheets("Sheet2")
        .Cells(1).CurrentRegion.Clear 'clear existing data
        .Cells(1).Resize(UBound(ArrTrns, 1), UBound(ArrTrns, 2)) = ArrTrns
    End With
    
    MsgBox Round(Timer - StartTime, 2)

End Sub

[winfy]

Thanks Mancubus. I will definitely buy a book and learn more about vba. However, in the meantime I need to get something done for work. Can you just show me where and how I would make the code start from cell c17, instead of cell a1? For the single table scenario.

thanks

winfy

[mancubus]

upload your workbook. alter any sensitive, company specific data.

[snb]

This is what we call 'normalising' data:

Sub M_snb()
   sn = Sheet1.Cells(1).CurrentRegion
   ReDim sp((UBound(sn) - 1) * (UBound(sn, 2) - 1), 2)
   
   For j = 0 To UBound(sp) - 1
     x = j \ (UBound(sn, 2) - 1) + 2
     y = j Mod (UBound(sn, 2) - 1) + 2
     sp(j, 0) = sn(x, 1)
     sp(j, 1) = sn(1, y)
     sp(j, 2) = sn(x, y)
   Next
   
   Cells(25, 1).Resize(UBound(sp) + 1, UBound(sp, 2) + 1) = sp
End Sub

[winfy]

upload your workbook. alter any sensitive, company specific data.

Hi Mancubus, see attached.

I just realised I need it in a slightly more complicated format.

To recap, there are names in column B and there are dates in column AF to AQ.

I want to create another sheet where columns AF to AQ are stacked in one column, while all other columns are populating with the same information, such as the names.

Please let me know if it doesn't make sense. As i said before, I need it for 500 rows and 15 columns.

For example:

Original

Full name

Position

VIP Group Name

Group count

Business Group

VIP/ESS?

Region

Proposed Engagement Start

Actual Engagement Start

Proposed site survey

Actual site survey

Go/ No Go

Proposed migration

Actual Migration

Email 1

Email 2

Email 3

Email 4

Email 5

Adam Strange

Ange

Adam Strange

2

Business Group 7

VIP

Ainslie

11-Apr-2017

16-Apr-2017

26-Apr-2017

21-Apr-2017

1-May-2017

26-Apr-2017

6-May-2017

6-May-2017

11-May-2017

16-May-2017

21-May-2017

26-May-2017

Modified

Full name	Position	VIP Group Name	Group count	Business Group	VIP/ESS?	Region	Key Delivery	Dates
Adam Strange	Ange	Adam Strange	2	Business Group 7	VIP	Ainslie	Proposed Engagement Start	11-Apr-2017
Adam Strange	Ange	Adam Strange	2	Business Group 7	VIP	Ainslie	Actual Engagement Start	16-Apr-2017
Adam Strange	Ange	Adam Strange	2	Business Group 7	VIP	Ainslie	Proposed site survey	26-Apr-2017
Adam Strange	Ange	Adam Strange	2	Business Group 7	VIP	Ainslie	Actual site survey	21-Apr-2017
Adam Strange	Ange	Adam Strange	2	Business Group 7	VIP	Ainslie	Go/ No Go	1-May-2017
Adam Strange	Ange	Adam Strange	2	Business Group 7	VIP	Ainslie	Proposed migration	26-Apr-2017
Adam Strange	Ange	Adam Strange	2	Business Group 7	VIP	Ainslie	Actual Migration	6-May-2017
Adam Strange	Ange	Adam Strange	2	Business Group 7	VIP	Ainslie	Email 1	6-May-2017
Adam Strange	Ange	Adam Strange	2	Business Group 7	VIP	Ainslie	Email 2	11-May-2017
Adam Strange	Ange	Adam Strange	2	Business Group 7	VIP	Ainslie	Email 3	16-May-2017
Adam Strange	Ange	Adam Strange	2	Business Group 7	VIP	Ainslie	Email 4	21-May-2017
Adam Strange	Ange	Adam Strange	2	Business Group 7	VIP	Ainslie	Email 5	26-May-2017

[winfy]

This is what we call 'normalising' data:

Sub M_snb()
   sn = Sheet1.Cells(1).CurrentRegion
   ReDim sp((UBound(sn) - 1) * (UBound(sn, 2) - 1), 2)
   
   For j = 0 To UBound(sp) - 1
     x = j \ (UBound(sn, 2) - 1) + 2
     y = j Mod (UBound(sn, 2) - 1) + 2
     sp(j, 0) = sn(x, 1)
     sp(j, 1) = sn(1, y)
     sp(j, 2) = sn(x, y)
   Next
   
   Cells(25, 1).Resize(UBound(sp) + 1, UBound(sp, 2) + 1) = sp
End Sub

Thanks Snb!

[snb]

That's a completely different question:

Sub M_snb()
  sn = Sheet1.Cells(1).CurrentRegion
  ReDim sp((UBound(sn) - 1) * 12, 8)
     
  For j = 0 To UBound(sp) - 1
    x = j \ 12 + 2
    y = j Mod 12 + 32
    For jj = 0 To 5
      sp(j, jj) = sn(x, jj + 2)
    Next
    sp(j, 6) = sn(x, 24)
    sp(j, 7) = sn(1, y)
    sp(j, 8) = sn(x, y)
  Next
     
  Sheet2.Cells(1).Resize(UBound(sp) + 1, UBound(sp, 2) + 1) = sp
  Sheet2.Cells(1).CurrentRegion.Columns(9).NumberFormat = "dd/mm/yyyy"
End Sub

You could have made this code yourself based on the earlier suggestion I made.
Please analyse the code before using it.

[winfy]

That's a completely different question:

Sub M_snb()
  sn = Sheet1.Cells(1).CurrentRegion
  ReDim sp((UBound(sn) - 1) * 12, 8)
     
  For j = 0 To UBound(sp) - 1
    x = j \ 12 + 2
    y = j Mod 12 + 32
    For jj = 0 To 5
      sp(j, jj) = sn(x, jj + 2)
    Next
    sp(j, 6) = sn(x, 24)
    sp(j, 7) = sn(1, y)
    sp(j, 8) = sn(x, y)
  Next
     
  Sheet2.Cells(1).Resize(UBound(sp) + 1, UBound(sp, 2) + 1) = sp
  Sheet2.Cells(1).CurrentRegion.Columns(9).NumberFormat = "dd/mm/yyyy"
End Sub

You could have made this code yourself based on the earlier suggestion I made.
Please analyse the code before using it.

Snb, thanks for the code. When I try to run it, I hit an error at ReDim sp((UBound(sn) - 1) * 12, 8)


The error message is Run-time error '13'
Type mismatch.

Do you know why I am getting that error message

[mancubus]

The error message is Run-time error '13'
Type mismatch.

code assumes you have a normal excel table.

it means table's topleft cell is A1,
Row 1 is the header row,
Row 1 and Column 1 of the table contain no blank cells.

dont leave blank: Column A & Row 1


another point: dont quote previous messages. just refer them or quote related part when needed!

[winfy]

Hi Mancubus, thanks for your reply.

The table was a format table. I pasted values to a new Sheet1 and I do not get that error anymore.

However, I do encounter another error though under the line sp(j, 7) = sn(1, y)

The error message is Run Time Error 9, Subscript out of bounds. I haven't made any changes to the dimensions I have provided earlier.

[snb]

You applied the code to a different workbook than you posted.