Option Explicit
Sub ReorgData()
' hiker95, 08/28/2011
' http://www.mrexcel.com/forum/showthread.php?t=574976
Dim I(), A(), O(), k
Dim d As Object
Dim r As Long, c As Long, f As Long, s As Long, e As Long
Set d = CreateObject("scripting.dictionary")
I = Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 3))
A = Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
For r = 1 To UBound(A)
If Not d.exists(A(r, 1)) Then d(A(r, 1)) = d.Count
Next r
k = d.Keys
ReDim O(1 To d.Count + 1, 1 To 4)
For r = 1 To d.Count
O(r, 1) = k(r - 1)
Next r
O(1, 2) = "EN"
O(1, 3) = "EV"
O(1, 4) = "EG"
For r = 2 To d.Count
s = Application.Match(O(r, 1), A, 0)
e = Application.Match(O(r, 1), A, 1)
For c = s To e
If LCase(I(c, 2)) = "en" Or UCase(I(c, 2)) = "EN" Then
O(r, 2) = I(c, 3)
ElseIf I(c, 2) = "EV" Then
O(r, 3) = I(c, 3) / 1000
ElseIf LCase(I(c, 2)) = "ev" And O(r, 3) = "" Then
O(r, 3) = I(c, 3) / 1000
ElseIf I(c, 2) = "EG" Then
O(r, 4) = I(c, 3) / 1000
End If
Next c
Next r
Columns("E:H").Clear
Range("E1").Resize(UBound(O), 4) = O
Range("E1:H" & UBound(O)).HorizontalAlignment = xlCenter
Range("G2:H" & UBound(O)).NumberFormat = "0.000%"
End Sub
