How to group a table using VBA?

[maryann]

Dear Excel GURU:
I have a table below:
PC PCGRp2
44 1
62 2
63 2
54 2
47 2
15 3
42 3
57 3
85 3
33 4
43 4
95 4
53 5
64 5
45 5
55 5
65 5
75 5
46 6
66 6
35 7
48 7
58 7
68 7
32 8
56 8
37 8
52 9
34 9
67 9
38 9
25 10
36 10


Would like to have result like this
PCGRp2 PC
1 '44'
2 '62','63','54','47'
3 '15','42','57','85'
4 '33','43','95'
5 '53','64','45','55','65','75'
6 '46','66'
7 '35','48','58','68'
8 '32','56','37',
9 '52','34','67','38'
10 '25','36'


How can I achieve it using VBA macro?

Thanks,

Maryann

 

[Per Jessen]

Hi

Try this:

Sub GroupData()
Dim DestCell As Range
Set DestSh = Worksheets("Sheet2")
Set TargetSh = Worksheets("Sheet1")
Set DestCell = DestSh.Range("A2")
Target = TargetSh.Range("B2").Value
DestCell = Target
For r = 2 To TargetSh.Range("B2").End(xlDown).Row
If TargetSh.Cells(r, "B") = Target Then
DestCell.End(xlToRight).End(xlToRight).End(xlToLeft).Offset(0, 1) =
TargetSh.Cells(r, "A")
Else
Set DestCell = DestCell.Offset(1, 0)
Target = TargetSh.Cells(r, "B")
DestCell = Target
DestCell.Offset(0, 1) = TargetSh.Cells(r, "A")
End If
Next
End Sub

Regards,
Per

 

[maryann]

Thank you very much, Per. I tried your code and has results as below:

1 44
2 47
3 85
4 95
5 75
6 66
7 68
8 37
9 38
10 36
Not quite the ones I want.
PCGRp2 PC
1 '44'
2 '62','63','54','47'
3 '15','42','57','85'
4 '33','43','95'
5 '53','64','45','55','65','75'
6 '46','66'
7 '35','48','58','68'
8 '32','56','37'
9 '52','34','67','38'
10 '25','36'


Any idea on how to achieve the desired results?

Thanks a million!

Maryann

 

[maryann]

Hi

Try this:

Sub GroupData()
Dim DestCell As Range
Set DestSh = Worksheets("Sheet2")
Set TargetSh = Worksheets("Sheet1")
Set DestCell = DestSh.Range("A2")
Target = TargetSh.Range("B2").Value
DestCell = Target
For r = 2 To TargetSh.Range("B2").End(xlDown).Row
    If TargetSh.Cells(r, "B") = Target Then
        DestCell.End(xlToRight).End(xlToRight).End(xlToLeft).Offset(0, 1) =
TargetSh.Cells(r, "A")
    Else
        Set DestCell = DestCell.Offset(1, 0)
        Target = TargetSh.Cells(r, "B")
        DestCell = Target
        DestCell.Offset(0, 1) = TargetSh.Cells(r, "A")
    End If
Next
End Sub

Regards,
Per

"maryann" <[email protected]> skrev i meddelelsen







- Show quoted text -

Thanks, after some modification, I achieved the results I wanted.