1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
|
Sub MakeSummary()
Dim wb As Workbook
Dim ds As Worksheet, os As Worksheet
Dim lRow As Long, i As Long, j As Long, fRecord As Long
Set wb = ThisWorkbook
Set os = wb.Worksheets("UnattendedActivity")
Set ds = wb.Worksheets.Add(After:=os)
ds.Name = "Summary"
lRow = os.Range("A65536").End(xlUp).Row
os.Cells(7, 1).Copy ds.Cells(1, 1)
ds.Cells(1, 2).Value = os.Cells(7, 2).Value
ds.Cells(1, 3).Value = os.Cells(7, 9).Value
ds.Cells(1, 1).Copy
ds.Range("B1:C1").PasteSpecial xlPasteFormats
ds.Cells(1, 1).ColumnWidth = 15.14
ds.Cells(1, 2).ColumnWidth = 18.57
ds.Cells(1, 3).ColumnWidth = 10
ds.Cells(1, 4).ColumnWidth = 1.29
ds.Cells(1, 5).ColumnWidth = 2.29
ds.Cells(1, 6).ColumnWidth = 2.29
ds.Cells(1, 7).ColumnWidth = 4.43
ds.Cells(1, 8).ColumnWidth = 5.57
ds.Cells(1, 9).ColumnWidth = 7
j = lRow - 6
fRecord = j
os.Range("A8:A" & lRow).Copy
ds.Range("A2").PasteSpecial xlPasteValues
ds.Range("A2").PasteSpecial xlPasteFormats
os.Range("B8:B" & lRow).Copy
ds.Range("B2").PasteSpecial xlPasteValues
os.Range("I8:I" & lRow).Copy ds.Range("C2")
ds.Range("A2:C" & j).Sort Key1:=Range("A2"), Order1:=xlDescending, Key2:=Range("B2") _
, Order2:=xlDescending, Header:=xlNo, OrderCustom:=1, MatchCase:=False _
, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal
For i = lRow To 8 Step -1
ds.Cells(j, 4) = Hour(ds.Cells(j, 3))
ds.Cells(j, 5) = Minute(ds.Cells(j, 3))
ds.Cells(j, 6) = Second(ds.Cells(j, 3))
If ds.Cells(j, 1) <> ds.Cells(j - 1, 1) Or ds.Cells(j, 2) <> ds.Cells(j - 1, 2) Then
ds.Cells(j, 9).Formula = "=SUM(F" & j & ":F" & fRecord & ")/60"
ds.Cells(j, 8).Formula = "=SUM(E" & j & ":E" & fRecord & ")+I" & j & "/60"
ds.Cells(j, 7).Formula = "=SUM(D" & j & ":D" & fRecord & ")+H" & j & "/60"
ds.Cells(j, 3).Formula = "=G" & j & "/24"
ds.Cells(j, 3).NumberFormat = "h:mm"
fRecord = j - 1
Else
ds.Range("A" & j).EntireRow.Hidden = True
ds.Cells(j, 3) = ""
End If
j = j - 1
Next i
ds.Range("D4:I4").EntireColumn.Hidden = True
End Sub
Sub NewTimeLine()
Dim wb As Workbook
Dim ds As Worksheet, os As Worksheet
Dim lRow As Long, i As Long, j As Long, k As Long, tCounter As Long, rCounter As Long, nCol As Long
Dim cRange As Range
Set wb = ThisWorkbook
Set os = wb.Worksheets("Summary")
Set ds = wb.Worksheets.Add(After:=os)
ds.Name = "Timeline"
ds.Cells(1, 1) = "TIMELINE"
ds.Cells(1, 1).Font.Bold = True
ds.Cells(1, 1).ColumnWidth = 12.57
lRow = os.Range("A65536").End(xlUp).Row
tCounter = 2
j = 2
For i = 2 To lRow
If os.Cells(i + 1, 1) <> os.Cells(i, 1) Then
ds.Cells(j, 1) = os.Cells(i, 1)
rCounter = tCounter
For k = rCounter To i
If os.Cells(k, 2) <> os.Cells(k + 1, 2) Or os.Cells(k, 1) <> os.Cells(k + 1, 1) Then
Set cRange = ds.Range("B1:IV1").Find(os.Cells(k, 2))
If Not cRange Is Nothing Then
ds.Cells(j, cRange.Column) = os.Cells(rCounter, 3)
ds.Cells(j, cRange.Column).NumberFormat = "h:mm"
Else
nCol = ds.Range("IV1").End(xlToLeft).Column + 1
ds.Cells(1, nCol) = os.Cells(k, 2)
ds.Cells(1, nCol).Font.Bold = True
ds.Cells(1, nCol).ColumnWidth = 11.29
ds.Cells(j, nCol) = os.Cells(rCounter, 3)
ds.Cells(j, nCol).NumberFormat = "h:mm"
End If
rCounter = k + 1
End If
Next k
j = j + 1
tCounter = i + 1
End If
Next i
ds.Cells(j, 1) = "Grand Totals"
For i = 2 To nCol
ds.Cells(j, i).Formula = "=Sum(" & ds.Cells(2, i).Address & ":" & ds.Cells(j - 1, i).Address & ")"
Next i
ds.Cells(j, nCol + 1).Formula = "=Sum(" & ds.Cells(j, 2).Address & ":" & ds.Cells(j, nCol).Address & ")"
ds.Range(ds.Cells(j, 1), ds.Cells(j, nCol + 1)).Font.Bold = True
ds.Range(ds.Cells(j, 1), ds.Cells(j, nCol + 1)).NumberFormat = "[h]:mm:ss;@"
ds.UsedRange.HorizontalAlignment = xlCenter
End Sub
|
