-
Notifications
You must be signed in to change notification settings - Fork 0
/
NSC_Formatting
241 lines (217 loc) · 8.51 KB
/
NSC_Formatting
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
Option Explicit
Sub NSC_FORMATTING()
'
' NSC StudentTracker Formatting Macro
' For formatting files for National Student Clearinghouse's StudentTracker service. Original file must have first name, middle name, last name, YYYYMMDD birth date and student ID in Columns A to E in that order, with headings.
Dim aFill, searchDate, creationDate, welcome As Long
Dim inputQuestion, todayDate, schoolName, schoolCode, branchCode, queryOption As String
Dim rng, cell As Range
Dim numberCount, wrongDateCount As Integer
'CHANGE THESE LINES TO MATCH YOUR INSTITUTION.
schoolName = "ABC UNIVERSITY"
schoolCode = "000000"
branchCode = "00"
queryOption = "SE"
'Welcome message
welcome = MsgBox(prompt:="This script will format CO, DA, or SE queries for upload to National Student Clearinghouse's StudentTracker service." _
& vbCrLf & vbCrLf & "Original file must have first name, middle name, last name, YYYYMMDD birth date and student ID in Columns A to E IN THAT ORDER, with headings." _
& vbCrLf & vbCrLf & "It assumes you do not have a separate column for surname suffix." _
& vbCrLf & "While it will format the file it will not remove errors, of which some of the most common will be listed on the right." _
& " You must delete these extra columns once finished for a successful upload to NSC." _
& vbCrLf & vbCrLf & "To avoid typing your institution's info each time they are hard coded into the beginning of the script." _
& " You should adjust them in the Visual Basic Editor." _
& vbCrLf & vbCrLf & "As this file will be modified, you may wish to save a copy first before continuing. Otherwise, click OK." _
, Title:="NSC StudentTracker Formatting Macro", Buttons:=vbOKCancel)
If welcome = vbCancel Then
Exit Sub
End If
Dim numberArray() As Variant
ReDim numberArray(1)
numberArray(1) = "Locations:"
Dim wrongDateArray() As Variant
ReDim wrongDateArray(1)
wrongDateArray(1) = "Locations:"
todayDate = Format(Date, "YYYYMMDD")
creationDate = todayDate
inputQuestion = "Enter NSC search start date as YYYYMMDD. Date cannot be in the future."
'loops for incorrect number, but does not check for everything or most things
Do
searchDate = Application.InputBox(prompt:=inputQuestion, Title:="Search Start Date", Default:=Format(Date, "YYYYMMDD"), Type:=1)
Loop While searchDate > CLng(todayDate)
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A2").Select
ActiveCell.FormulaR1C1 = "D1"
aFill = Range("B" & Rows.Count).End(xlUp).Row
Range("A2:A" & aFill).FillDown
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Range("D2").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-1], 20)"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D" & aFill)
Range("D2:D" & aFill).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("C:C").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Range("E2").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-1], 1)"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E" & aFill)
Range("E2:E" & aFill).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("D:D").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("F:F").Select
Selection.Insert Shift:=xlToRight
Range("F2").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-1], 20)"
Range("F2").Select
Selection.AutoFill Destination:=Range("F2:F" & aFill)
Range("F2:F" & aFill).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("E:E").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("F:F").Select
Selection.Insert Shift:=xlToRight
Columns("H:H").Select
Selection.Insert Shift:=xlToRight
Range("H2").Select
Range("H2").Value = searchDate
Range("H2:H" & aFill).FillDown
Columns("I:I").Select
Selection.Insert Shift:=xlToRight
Cells.Select
Range("I1").Activate
Selection.NumberFormat = "@"
Columns("J:J").Select
Selection.Insert Shift:=xlToRight
Range("J2").Select
Range("J2").Value = schoolCode
Range("J2:J" & aFill).FillDown
Columns("K:K").Select
Selection.Insert Shift:=xlToRight
Range("K2").Select
Range("K2").Value = "00"
Range("K2:K" & aFill).FillDown
Range("K2:K" & aFill).Select
Range("L1").Select
Selection.ClearContents
Rows("1:1").Select
Selection.ClearContents
Range("A1").Select
ActiveCell.FormulaR1C1 = "H1"
Range("B1").Select
ActiveCell.FormulaR1C1 = schoolCode
Range("C1").Select
ActiveCell.FormulaR1C1 = branchCode
Range("D1").Select
ActiveCell.FormulaR1C1 = schoolName
Range("E1").Select
ActiveCell.FormulaR1C1 = creationDate
Range("F1").Select
ActiveCell.FormulaR1C1 = queryOption
Range("G1").Select
ActiveCell.FormulaR1C1 = "I"
Range("A1").Select
Selection.End(xlDown).Select
'Footer row
Range("A" & (aFill + 1)).Select
ActiveCell.FormulaR1C1 = "T1"
ActiveCell.Offset(0, 1).Select
Selection.NumberFormat = "General"
ActiveCell.FormulaR1C1 = "=ROW()"
Cells.Select
ActiveCell.Activate
Selection.NumberFormat = "@"
Range("A1").Select
'Adjusts column widths
Columns("A").ColumnWidth = 3
Columns("F:H").ColumnWidth = 9
Columns("I").ColumnWidth = 2
Columns("J").ColumnWidth = 7
Columns("K").ColumnWidth = 2
Columns("M").ColumnWidth = 7
Columns("N").ColumnWidth = 22
'Checks for special phrases that often result in errors when submitting to NSC
'Suffixes are often found after last name when they belong in separate column for NSC
'Periods after "St." are usually fine but others should be removed.
Range("N2") = "Count of suffixes and phrases that can result in NSC errors--correct manually"
Range("N3") = "JR"
Range("N4") = "SR"
Range("N5") = "II"
Range("N6") = "III"
Range("N7") = "IV"
Range("N8") = "NLN"
Range("N9") = "NFN"
Range("N10") = "Birth Year < 1910"
Range("N11") = "Periods (.)"
Range("N12") = "Underscores (_)"
Range("N13") = "Open Parenthesis ("
Range("N14") = "Close Parenthesis )"
Range("N15") = Chr(34) & Chr(45) & Chr(34) & " in Middle Name Field"
Range("N16") = "!"
Range("N17") = "?"
Range("N18") = "Any Numbers Saved as Text"
Range("O3") = Application.WorksheetFunction.CountIf(Range("C2:E" & aFill), "* JR*")
Range("O4") = Application.WorksheetFunction.CountIf(Range("C2:E" & aFill), "* SR*")
Range("O5") = Application.WorksheetFunction.CountIf(Range("C2:E" & aFill), "* II")
Range("O6") = Application.WorksheetFunction.CountIf(Range("C2:E" & aFill), "* III")
Range("O7") = Application.WorksheetFunction.CountIf(Range("C2:E" & aFill), "* IV")
Range("O8") = Application.WorksheetFunction.CountIf(Range("C2:E" & aFill), "*NLN*")
Range("O9") = Application.WorksheetFunction.CountIf(Range("C2:E" & aFill), "*NFN*")
Range("O11") = Application.WorksheetFunction.CountIf(Range("C2:E" & aFill), "*.*")
Range("O12") = Application.WorksheetFunction.CountIf(Range("C2:E" & aFill), "*_*")
Range("O13") = Application.WorksheetFunction.CountIf(Range("C2:E" & aFill), "*(*")
Range("O14") = Application.WorksheetFunction.CountIf(Range("C2:E" & aFill), "*)*")
Range("O15") = Application.WorksheetFunction.CountIf(Range("D2:D" & aFill), "*-*")
Range("O16") = Application.WorksheetFunction.CountIf(Range("C2:E" & aFill), "*!*")
Range("O17") = Application.WorksheetFunction.CountIf(Range("C2:E" & aFill), "*~?*")
'Check to see if there are any birth dates that are not humanely possible for current students.
wrongDateCount = 0
Set rng = Range("G2:G" & aFill)
For Each cell In rng.Cells
If cell.Value < 19100101 Then
wrongDateCount = wrongDateCount + 1
ReDim Preserve wrongDateArray(UBound(wrongDateArray) + 1)
wrongDateArray(UBound(wrongDateArray)) = cell.Address
End If
Next
Range("O10") = wrongDateCount
If wrongDateCount > 0 Then
Dim Destination As Range
Set Destination = Range("P10")
Set Destination = Destination.Resize(1, UBound(wrongDateArray) + 1)
Destination.Value = wrongDateArray
End If
'Check to see if there are any values in the name columns that are numbers, an error.
numberCount = 0
Set rng = Range("C2:E" & aFill)
For Each cell In rng.Cells
If IsNumeric(cell) Then
numberCount = numberCount + 1
ReDim Preserve numberArray(UBound(numberArray) + 1)
numberArray(UBound(numberArray)) = cell.Address
End If
Next
Range("O18") = numberCount
If numberCount > 0 Then
Dim Destination1 As Range
Set Destination1 = Range("P18")
Set Destination1 = Destination1.Resize(1, UBound(numberArray) + 1)
Destination1.Value = numberArray
End If
End Sub