Rearranging data

  • Thread starter Thread starter John Pierce
  • Start date Start date
J

John Pierce

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








- Show quoted text -
Click to expand...

OssieMac, Thank you. Your procedure works perfectly.
 
Back
Top