Excel 2007 | |||||||||
---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | |||
1 | A | 3 | |||||||
2 | B | 2 | |||||||
3 | B | 8 | |||||||
4 | A | 6 | |||||||
5 | B | 1 | |||||||
6 | |||||||||
Sheet1 |
Excel 2007 | |||||||||
---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | |||
1 | A | 3 | A | 3 | 6 | ||||
2 | B | 2 | B | 2 | 8 | 1 | |||
3 | B | 8 | |||||||
4 | A | 6 | |||||||
5 | B | 1 | |||||||
6 | |||||||||
Sheet1 |
Sub ReorgData()
' hiker95, 05/24/2014, ME780017
Dim oa As Variant
Dim r As Long, lr As Long, nr As Long, nc As Long, n As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
oa = Range("A1:B" & lr)
Range("A1:B" & lr).Sort key1:=Range("A1"), order1:=1
nr = 0
For r = 1 To lr
n = Application.CountIf(Columns(1), Cells(r, 1).Value)
If n = 1 Then
nr = nr + 1
Cells(nr, 4).Resize(, 2).Value = Cells(r, 1).Resize(, 2).Value
ElseIf n > 1 Then
nr = nr + 1
Cells(nr, 4).Value = Cells(r, 1).Value
Cells(nr, 5).Resize(, n).Value = Application.Transpose(Range("B" & r & ":B" & r + n - 1).Value)
End If
r = r + n - 1
Next r
Range("A1:B" & lr) = oa
Columns.AutoFit
Application.ScreenUpdating = True
End Sub
Anyway I saw this solution you produced and tweaked my demo file to include the VBA solution you produced here.
So just a courtesy call to let you know and I hope it was ok to use your work
Hi that great and yes I kept yr heading and I guess you looked on page 1 because the link at the end of page 2 has the macro in it !
the formula based solution was a bugger also lol
Thank you very much for your help.
When I try to use a code to brig the exact same data a error appears