-
Notifications
You must be signed in to change notification settings - Fork 0
/
MasterSheet
150 lines (113 loc) · 4.28 KB
/
MasterSheet
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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
Sub MasterSheet()
Dim SH As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long
Dim i As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
' Writes the date and time the program was ran in H1
Sheets("Tool Master").Select
Range("B1").Select
ActiveCell.FormulaR1C1 = "=NOW()"
'Delete the sheet "Master Sheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Master Sheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True
'Deletes links on "Tool Master"
Dim cell As Range
Range("D3:D1001").Select
Selection.ClearContents
'writes new links based on sheet name and cells G2 & H2
Range("D3").Select
For Each SH In ActiveWorkbook.Worksheets
If ActiveSheet.Name <> SH.Name Then
ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"'" & SH.Name & "'" & "!A1", TextToDisplay:=(SH.Name & " " & SH.Range("I2") & " " & SH.Range("H2"))
ActiveCell.Offset(1, 0).Select
End If
Next SH
'Sorts job links alphabetically
Range("D3:D1001").Select
ActiveWorkbook.Worksheets("Tool Master").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Tool Master").Sort.SortFields.Add Key:=Range("D6") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tool Master").Sort
.SetRange Range("D3:D1001")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
Range("D2").Select
End With
'Add a worksheet with the name "Master Sheet"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Master Sheet"
'Fill in the start row
StartRow = 2
'loop through all worksheets and copy the data to the DestSh
For Each SH In ActiveWorkbook.Worksheets
'Ignores sheet "Tool Master"
If IsError(Application.Match(SH.Name, _
Array(DestSh.Name, "Tool Master"), 0)) Then
'Copy header row, change the range if you use more columns
If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
SH.Range("A1:Z1").Copy DestSh.Range("A1")
End If
'Find the last row with data on the DestSh and sh
Last = LastRow(DestSh)
shLast = LastRow(SH)
'If sh is not empty and if the last row >= StartRow copy the CopyRng
If shLast > 0 And shLast >= StartRow Then
'Set the range that you want to copy
Set CopyRng = SH.Range(SH.Rows(StartRow), SH.Rows(shLast))
'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If
' Copies values
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
'Optional: This will copy the sheet name in the H column
DestSh.Cells(Last + 1, "I").Resize(CopyRng.Rows.Count).Value = SH.Name
DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = SH.Range("H2")
End If
End If
Next
ExitTheSub:
'Filter, Sort, and AutoFit the column width in the DestSh sheet
Application.GoTo DestSh.Cells(1)
'Filters on
Range("A1:J1").AutoFilter
'Sort
'Column width
DestSh.Columns.AutoFit
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
'freeze top row
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
'Update date and time
Sheets("Tool Master").Select
With Range("B1")
.Value = Date & " " & Time
.NumberFormat = "M/DD/YYYY h:mm AM/PM"
End With
End Sub