Rearranging data
 

I've been given some data that looks like this:
Name Docs
Name1 doc1
Name1 doc3
Name2 doc2
Name2 doc3
Name3 doc1
Name4 doc1
Name4 doc2
Name4 doc3
Name5 doc1
Name5 doc3
Name6 doc3

and I need it to look like this:

Name Doc1 Doc2 Doc3
Name1 X X
Name2 X X
Name3 X
Name4 X X X
Name5 X X
Name6 X

There are thousands of records but only three different doc types.
For each Name, all three docs might be there, or only one, or
any combination of two of them.

Rearranging data
 

Hi John,

try this.

Sub Rearrange()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rngNames As Range
Dim colNames As String
Dim c As Range
Dim saveName As String
Dim offSetCol As Long

Set ws1 = Sheets("Sheet1") 'Edit with original list sheet name
Set ws2 = Sheets("Sheet2") 'Edit with your Output sheet name

colNames = "A" 'Edit to your column of names

With ws1
Set rngNames = Range(.Cells(2, colNames), _
.Cells(.Rows.Count, colNames).End(xlUp))
End With

With ws2
.Cells(1, "A") = "Name"
.Cells(1, "B") = "Doc1"
.Cells(1, "C") = "Doc2"
.Cells(1, "D") = "Doc3"
End With

For Each c In rngNames
If c.Value < saveName Then
With ws2
.Cells(.Rows.Count, "A").End(xlUp). _
Offset(1, 0) = c.Value
saveName = c.Value
End With
End If
If c.Offset(0, 1) < "" Then
Select Case Right(c.Offset(0, 1), 1)
Case 1
offSetCol = 1
Case 2
offSetCol = 2
Case 3
offSetCol = 3
End Select
With ws2
.Cells(.Rows.Count, "A").End(xlUp). _
Offset(0, offSetCol) = "X"
End With
End If
Next c

End Sub


--
Regards,

OssieMac


"John Pierce" wrote:

I've been given some data that looks like this:
Name Docs
Name1 doc1
Name1 doc3
Name2 doc2
Name2 doc3
Name3 doc1
Name4 doc1
Name4 doc2
Name4 doc3
Name5 doc1
Name5 doc3
Name6 doc3

and I need it to look like this:

Name Doc1 Doc2 Doc3
Name1 X X
Name2 X X
Name3 X
Name4 X X X
Name5 X X
Name6 X

There are thousands of records but only three different doc types.
For each Name, all three docs might be there, or only one, or
any combination of two of them.

Rearranging data
 

On Mar 20, 3:39*am, OssieMac
wrote:
HiJohn,

try this.

Sub Rearrange()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rngNames As Range
Dim colNames As String
Dim c As Range
Dim saveName As String
Dim offSetCol As Long

Set ws1 = Sheets("Sheet1") *'Edit with original list sheet name
Set ws2 = Sheets("Sheet2") *'Edit with your Output sheet name

colNames = "A" *'Edit to your column of names

With ws1
* * Set rngNames = Range(.Cells(2, colNames), _
* * * * .Cells(.Rows.Count, colNames).End(xlUp))
End With

With ws2
* * .Cells(1, "A") = "Name"
* * .Cells(1, "B") = "Doc1"
* * .Cells(1, "C") = "Doc2"
* * .Cells(1, "D") = "Doc3"
End With

For Each c In rngNames
* * If c.Value < saveName Then
* * * * With ws2
* * * * * * .Cells(.Rows.Count, "A").End(xlUp). _
* * * * * * * * Offset(1, 0) = c.Value
* * * * * * saveName = c.Value
* * * * End With
* * End If
* * If c.Offset(0, 1) < "" Then
* * * * Select Case Right(c.Offset(0, 1), 1)
* * * * * * Case 1
* * * * * * * * offSetCol = 1
* * * * * * Case 2
* * * * * * * * offSetCol = 2
* * * * * * Case 3
* * * * * * * * offSetCol = 3
* * * * End Select
* * * * With ws2
* * * * * * .Cells(.Rows.Count, "A").End(xlUp). _
* * * * * * Offset(0, offSetCol) = "X"
* * * * End With
* * End If
Next c

End Sub

--
Regards,

OssieMac



"JohnPierce" wrote:
I've been given some data that looks like this:
Name * * * Docs
Name1 * * *doc1
Name1 * * *doc3
Name2 * * *doc2
Name2 * * *doc3
Name3 * * *doc1
Name4 * * *doc1
Name4 * * *doc2
Name4 * * *doc3
Name5 * * *doc1
Name5 * * *doc3
Name6 * * *doc3

and I need it to look like this:

Name * * * Doc1 * *Doc2 * *Doc3
Name1 * * *X * * * * * * * X
Name2 * * * * * * *X * * * X
Name3 * * *X
Name4 * * *X * * * X * * * X
Name5 * * *X * * * * * * * X
Name6 * * * * * * * * * * *X

There are thousands of records but only three different doc types.
For each Name, all three docs might be there, or only one, or
any combination of two of them.- Hide quoted text -

- Show quoted text -

OssieMac, Thank you. Your procedure works perfectly.