-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathTEST_Mod1
255 lines (176 loc) · 6.1 KB
/
TEST_Mod1
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
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
Option Explicit
Sub FormatJEL()
'WORKS--SLOW
'For Help Contact Amanda Norseth, Ext 55459, Created for Employee Health 2020.04.03
'FOR COVID-19 RESPONSE--EMPLOYEE HEALTH RESPIRATORY COMPLIANCE REPORT
'For use with JEL report from OHM
'Deletes garbage rows
'convert to number
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'DECLARE VARIABLES
Dim s3 As Worksheet
Dim lastrow As Integer
Dim rwr As Range
Dim row As Range
'SET DECLARED VARIABLES
Set s3 = Sheets("JEL")
lastrow = s3.Range("A10000").End(xlUp).row
Set rwr = s3.Range("A2:A" & lastrow)
'*********If employee cell empty, delete row***********
For Each row In rwr
On Error Resume Next
Columns("A").SpecialCells(xlBlanks).EntireRow.Delete
Next row
'***********Formatting JEL tab***************
'Select all in JEL and convert to number
Sheets("JEL").Select
Range("A2:O2", Range("A2:O2").End(xlDown).End(xlToRight)).Select
With Selection
.NumberFormat = "0"
.Value = .Value
End With
'Turn back on screen updating etc
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub TableJEL()
'WORKS
'For Help Contact Amanda Norseth, Ext 55459, Created for Employee Health 2020.04.03
'FOR COVID-19 RESPONSE--EMPLOYEE HEALTH RESPIRATORY COMPLIANCE REPORT
'Convert JEL to table
'DECLARE VARIABLES
Dim s3 As Worksheet
Dim tbl As ListObject
Dim rng As Range
Dim Name As String
'SET DECLARED VARIABLES
Set s3 = Sheets("JEL")
'Set Name = "jelt"
Set rng = s3.Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
Set tbl = s3.ListObjects.Add(xlSrcRange, rng, , xlYes)
s3.Range("b5").ListObject.Name = "jelt"
tbl.TableStyle = "TableStyleLight11"
End Sub
Sub TablePop()
'For Help Contact Amanda Norseth, Ext 55459, Created for Employee Health 2020.04.03
'FOR COVID-19 RESPONSE--EMPLOYEE HEALTH RESPIRATORY COMPLIANCE REPORT
'Convert Pop to table
'DECLARE VARIABLES
Dim s2 As Worksheet
Dim tbl As ListObject
Dim rng As Range
Dim Name As String
'SET DECLARED VARIABLES
Set s2 = Sheets("POPREP")
Set rng = s2.Range(Range("A3"), Range("A3").SpecialCells(xlLastCell))
Set tbl = s2.ListObjects.Add(xlSrcRange, rng, , xlYes)
s2.Range("b5").ListObject.Name = "popt"
tbl.TableStyle = "TableStyleLight11"
s2.ListObjects.Add(xlSrcRange, Range("A3:N3").End(xlDown).End(xlToRight), , xlYes).Name = _
"popt"
End Sub
Sub PopRepFormat()
'For Help Contact Amanda Norseth, Ext 55459, Created for Employee Health 2020.04.03
'FOR COVID-19 RESPONSE--EMPLOYEE HEALTH RESPIRATORY COMPLIANCE REPORT
'for use with OHM population report VM and crothall
'delete each row with date of report and headings
'DECLARE VARIABLES
Dim s2 As Worksheet
Dim lastrow As Integer
Dim rwr As Range
Dim row As Range
'SET DECLARED VARIABLES
Set s2 = Sheets("POPREP")
lastrow = s2.Range("A10000").End(xlUp).row
Set rwr = s2.Range("A4:A" & lastrow)
For Each row In rwr
On Error Resume Next
Columns("B4:B").SpecialCells(xlBlanks).EntireRow.Delete
Next row
With rwr
.Replace "Current Population List", True, xlWhole
.SpecialCells(xlCellTypeConstants, 4).EntireRow.Delete
End With
With rwr
.Replace "VMEMP", True, xlWhole
.SpecialCells(xlCellTypeConstants, 4).EntireRow.Delete
End With
End Sub
Sub CombiNums()
'For Help Contact Amanda Norseth, Ext 55459, Created for Employee Health 2020.04.03
'FOR COVID-19 RESPONSE--EMPLOYEE HEALTH RESPIRATORY COMPLIANCE REPORT
'combines all employee numbers from both reports poprep and JEL
'DECLARE VARIABLES
Dim s2 As Worksheet
Dim s3 As Worksheet
Dim s4 As Worksheet
Dim lastrow As Integer
Dim row As Range
'SET DECLARED VARIABLES
Set s2 = Sheets("POPREP")
Set s3 = Sheets("JEL")
Set s4 = Sheets("CONS")
lastrow = ActiveSheet.Range("A20000").End(xlUp).row
's4.Range("A20000").End(xlUp).row
'Copy empnos from POP report
ActiveWorkbook.Sheets("POPREP").Select
Sheets("POPREP").Range("A4", Range("a4").End(xlDown)).Select
Selection.Copy
ActiveWorkbook.Sheets("CONS").Select
Sheets("CONS").Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Copy empnos from JEL report
ActiveWorkbook.Sheets("JEL").Select
Sheets("JEL").Range("B2", Range("B2").End(xlDown)).Select
Selection.Copy
ActiveWorkbook.Sheets("CONS").Select
Sheets("CONS").Range("A1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Range(Cells(lastrow, 1), Cells(lastrow, 1)).Offset(1, 0).Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
' :=False, Transpose:=False
' Range(Cells(lastrow, 1), Cells(lastrow, 1)).Offset(1, 0).Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
' :=False, Transpose:=False
' Cells(lastrow + 1, 1).Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
' :=False, Transpose:=False
End Sub
Sub DeleteRows()
'For Help Contact Amanda Norseth, Ext 55459, Created for Employee Health 2020.04.03
'FOR COVID-19 RESPONSE--EMPLOYEE HEALTH RESPIRATORY COMPLIANCE REPORT
'deletes rows after row 100 from LIST tab
'DECLARE VARIABLES
Dim s5 As Worksheet
Dim lastrow As Long
'SET DECLARED VARIABLES
Set s5 = Sheets("LIST")
Set lastrow = Cells(Rows.Count, 1).End(xlUp).row
s5.Rows("101:101").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
End Sub
Sub PasteList()
'For Help Contact Amanda Norseth, Ext 55459, Created for Employee Health 2020.04.03
'FOR COVID-19 RESPONSE--EMPLOYEE HEALTH RESPIRATORY COMPLIANCE REPORT
'Copy employee nums to List table
'DECLARE VARIABLES
Dim s4 As Worksheet
Dim s5 As Worksheet
Dim lastrow As Long
'SET DECLARED VARIABLES
Set s4 = Sheets("CONS")
Set s5 = Sheets("LIST")
Set lastrow = Cells(Rows.Count, 1).End(xlUp).row
s4.Range("A4").End(xlDown).Select
Selection.Copy
s5.Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub