Transpose duplicate entries in column to new Row

[bluesifi]

Hi

I have a spreadsheet which has list of actions and the project they relate to. I would like to tidy up the data to have seperate row with project name and actions underneath. See examples below

Current Format

A1
Task 1 Joanne 15/02/2016 Project A
Task 2 Emily 23/03/2016 Project A
Task 3 Emily 14/03/2016 Project A
Task X David 15/04/2016 Project B
Task Y Joanne 15/04/2016 Project B
Task 10 Fran 13/02/2016 Project C

How I would like it to show

Project A
Task 1 Joanne 15/02/2016
Task 2 Emily 23/03/2016
Task 3 Emily 14/03/2016

Project B
Task X David 15/04/2016
Task Y Joanne 15/04/2016

Project C
Task 10 Fran 13/02/2016

Hope someone can help as I have nearly 200 rows to tidy each week.

 

[Fishboy]

Hi

I have a spreadsheet which has list of actions and the project they relate to. I would like to tidy up the data to have seperate row with project name and actions underneath. See examples below

Current Format

A1
Task 1 Joanne 15/02/2016 Project A
Task 2 Emily 23/03/2016 Project A
Task 3 Emily 14/03/2016 Project A
Task X David 15/04/2016 Project B
Task Y Joanne 15/04/2016 Project B
Task 10 Fran 13/02/2016 Project C

How I would like it to show

Project A
Task 1 Joanne 15/02/2016
Task 2 Emily 23/03/2016
Task 3 Emily 14/03/2016

Project B
Task X David 15/04/2016
Task Y Joanne 15/04/2016

Project C
Task 10 Fran 13/02/2016

Hope someone can help as I have nearly 200 rows to tidy each week.

Hi bluesifi, welcome to the boards.

Assuming that you place some headers as follows: Project A in C1, Project B in D1 and Project C in E1, you could use the following macro to trawl through column A and set your data out as you describe:

Sub ChangeDataLayout()
' Defines variables
Dim Cell As Range, cRange As Range
    ' Defines the last row of columns A, C, D and E
    LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    LRProjectA = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row + 1
    LRProjectB = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row + 1
    LRProjectC = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).Row + 1
        ' Sets the range to check as A1 to the last row of A
        Set cRange = Range("A1:A" & LastRow)
            ' For each cell in the check range
            For Each Cell In cRange
                ' If the last character is A then...
                If Right(Cell.Value, 1) = "A" Then
                    ' Add the value to the first blank row of column C and trim off the Project part
                    Range("C" & LRProjectA).Value = Replace(Cell.Value, " Project A", "")
                        ' Increase LRProjectA by 1 to account for the new data
                        LRProjectA = LRProjectA + 1
                ' If the last character is B then...
                ElseIf Right(Cell.Value, 1) = "B" Then
                    ' Add the value to the first blank row of column D and trim off the Project part
                    Range("D" & LRProjectB).Value = Replace(Cell.Value, " Project B", "")
                        ' Increase LRProjectB by 1 to account for the new data
                        LRProjectB = LRProjectB + 1
                ' If the last character is C then...
                ElseIf Right(Cell.Value, 1) = "C" Then
                    ' Add the value to the first blank row of column E and trim off the Project part
                    Range("E" & LRProjectC).Value = Replace(Cell.Value, " Project C", "")
                        ' Increase LRProjectC by 1 to account for the new data
                        LRProjectC = LRProjectC + 1
                End If
            ' Check next cell in check range
            Next Cell
End Sub

 

[oldbrewer]

Task 1 Joanne 15/02/2016 Project A			task1	joanne	15/02/2016	projA	projA
Task 2 Emily 23/03/2016 Project A			task2	emily	23/03/2016	projA
Task 3 Emily 14/03/2016 Project A			task3	emily	14/03/2016	projA
Task X David 15/04/2016 Project B			task x	david	15/04/2016	projb	projb
Task Y Joanne 15/04/2016 Project B			task y	joanne	15/04/2016	projb
Task 10 Fran 13/02/2016 Project C			task 10	fran	13/02/2016	projc	projc
How I would like it to show							automatic
Project A
Task 1 Joanne 15/02/2016
Task 2 Emily 23/03/2016			I used a helper column to identify project name changes
Task 3 Emily 14/03/2016
			then ran this macro
Project B
Task X David 15/04/2016			Sum = 29
Task Y Joanne 15/04/2016			For k = 1 To 6
			If Cells(k, 8) = "" Then GoTo 100
Project C			Sum = Sum + 2
Task 10 Fran 13/02/2016			Cells(Sum, 4) = Cells(k, 8)
			100 Sum = Sum + 1
			Cells(Sum, 4) = Cells(k, 4)
			Cells(Sum, 5) = Cells(k, 5)
			Cells(Sum, 6) = Cells(k, 6)
			Next k
			End Sub
			which produced this lower table
			projA
			task1	joanne	15/02/2016
			task2	emily	23/03/2016
			task3	emily	14/03/2016
			projb
			task x	david	15/04/2016
			task y	joanne	15/04/2016
			projc
			task 10	fran	13/02/2016

<colgroup><col><col span="4"><col><col span="3"></colgroup><tbody>
</tbody>