| When the ASN database is opened by a user a series of procedures are carried out to import data from external worksheets and process the data to allow users to correlate and filter all data sets using a range of criteria. As a result of this the program takes around 30s to load under normal server and connection speeds.
The code is accessed by pressing Alt F11 and finding the “this workbook” section. On clicking this, the code should appear, you need to view the workbook and open sections. |
| 1 | ||
| 2 |  |
|
| Next the program starts to import data (Sheets.Add Type:= _). The first set of data is the CAT data, held in an external file.
The path and address are: “P:\Pupil Support\ASN Database Files\Source Reference Files\CAT Data.xlsx” The progress CAT.show statement causes a brief graphic to appear. It does not indicate anything, but reassures the user that the program is continuing to load. A number of progress. show statements appear in this sequence to perform the same function. Imported sheets are best imported from workbooks without macros as macros can often request user interaction slowing the load speed. The CAT data is processed to allow a searchable name to be created on the inserted column D by concatenating the two names, the copying the formula down. |
||
| 3. |  |
|
| 4. | The initial part of the code declares some variables which will be used in the procedure and also sets the screen for the user.
This part of the code contains two features to help with errors. The first is the “On error resume next” statement; if procedure errors, it will if possible (not always) continue. The second is “Application.display alerts = false”. This second statement stops the program seeking conformation from the user to delete sheets. A number of imported sheets will subsequently be deleted. This approach offers the advantage of allowing the user to experience fewer program failures, but may also allow errors in data processing in particular to go undetected for some time. |
|
Private Sub Workbook_Open()
On Error Resume Next
With Worksheets("Data Entry")
.Visible = True
.Activate
End With
ProgressLOAD.Show
Dim sht As Worksheet
Dim msg As String
Dim Dt As Date
Dim Tm As String
Dim msgttl As String
Dim hlp As Integer
Dim ds As Integer
Dim usr As String
Dim Importsheet As Worksheet 'Imports worksheet from a closed workbook
'Import/ Process CAT DATA
Application.DisplayFullScreen = True
ActiveWindow.DisplayHeadings = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.DisplayFormulaBar = False
'Application.DisplayScrollBars = False
Application.CommandBars("standard").Enabled = False
Application.CommandBars("drawing").Enabled = False
Application.CommandBars("formatting").Enabled = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'IMPORT CAT DATA
ProgressCAT.Show
Sheets.Add Type:= _
Application.ThisWorkbook.Path & "\Source Reference Files\CAT Data.xlsx"
With Worksheets("CAT")
.Activate
lnglastrow = Cells(Rows.Count, "A").End(xlUp).Row
Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("D2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-3],"" "",RC[-2])"
Range("D2").Select
Columns("D:D").EntireColumn.AutoFit
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D" & lnglastrow), Type:=xlFillDefault
End With
'IMPORT ASN RECORDS
Sheets.Add Type:= _
Application.ThisWorkbook.Path & "\Source Reference Files\ASN Records.xlsx"
With Worksheets("ASNDiagnoses")
.name = "Diagnoses"
.Visible = False
End With
With Worksheets("ASNLists")
Dim ASNUPDT As String
ASNUPDT = Cells(1, 3).Value
.Visible = False
End With
With Worksheets("Data Entry")
.Visible = True
.Activate
End With
'IMPORT CURRENT SEEMIS DATA
ProgressSEEMIS.Show
Sheets.Add Type:= _
Application.ThisWorkbook.Path & "\Source Reference Files\SEEMIS_RCRDSMED.xlsx"
With Worksheets("Sheet2")
.Delete
End With
With Worksheets("Sheet3")
.Delete
End With
On Error Resume Next
With Worksheets("Sheet1")
.Activate
.Visible = True
Sheets("Sheet1").Select
Sheets("Sheet1").name = "SEEMIS_RCRDS"
Dim SEEMISUPDT As String
SEEMISUPDT = Cells(1, 1).Value
'FIND LAST FILLED ROW
lnglastrow = Cells(Rows.Count, "C").End(xlUp).Row
lnglastrow = lnglastrow + 100
'COPY MECIAL DATA TO COLUMN AF:AG
Columns("AD:AE").Select
Selection.Copy
Columns("AF:AG").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'COPY PREFERRED ROUTE TO COLUMN AD
Columns("K:K").Select
Selection.Copy
Columns("AE:AE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' PROCESS TO DEAL WITH PUPILS WITH IDENTICAL NAMES [Ibrahim Queshi]
Set ws = Worksheets("SEEMIS_RCRDS")
Dim DicSEEMIS As Object: Set DicSEEMIS = CreateObject("Scripting.Dictionary")
For Each rCell In ws.Range("A1", ws.Cells(Rows.Count, "A").End(xlUp))
If Not DicSEEMIS.exists((rCell.Value)) And rCell.Value = "N179" Then
DicSEEMIS.Add (rCell.Value), Nothing
rCell.Select
ActiveCell.Offset(rowOffset:=0, columnoffset:=3).Value = "Qureshi [E]"
End If
Next rCell
For Each rCell In ws.Range("A1", ws.Cells(Rows.Count, "A").End(xlUp))
If Not DicSEEMIS.exists((rCell.Value)) And rCell.Value = "N222" Then
DicSEEMIS.Add (rCell.Value), Nothing
rCell.Select
ActiveCell.Offset(rowOffset:=0, columnoffset:=3).Value = "Qureshi [B]"
End If
Next rCell
'INSERT ROW
Range("A1").Select
Rows(1).Insert Shift:=xlShiftDown
'INSERT COLUMNS E:G - FILL WITH CONCATENATED NAMES
Columns("E:G").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E1").Select
ActiveCell.FormulaR1C1 = "KNOWN AS NAME"
Range("E2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-3],"" "",RC[-1])"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E" & lnglastrow), Type:=xlFillDefault
Range("E2:E" & lnglastrow).Select
Range("F1").Select
ActiveCell.FormulaR1C1 = "FORENAME NAME"
Range("F2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-3],"" "",RC[-2])"
Range("F2").Select
Selection.AutoFill Destination:=Range("F2:F" & lnglastrow), Type:=xlFillDefault
Range("F2:F" & lnglastrow).Select
Range("G1").Select
ActiveCell.FormulaR1C1 = "SQA NAME"
Range("G2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[4],"" "",RC[-3])"
Range("G2").Select
Selection.AutoFill Destination:=Range("G2:G" & lnglastrow), Type:=xlFillDefault
Range("G2:G" & lnglastrow).Select
'GET CAT
Columns("M:M").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("O2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-10],CAT!C[-11]:C[-5],2,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC[-10],CAT!C[-11]:C[-5],2,FALSE)),"""",VLOOKUP(RC[-10],CAT!C[-11]:C[-5],2,FALSE)))"
Selection.AutoFill Destination:=Range("O2:O" & lnglastrow), Type:=xlFillDefault
Range("O2:O" & lnglastrow).Select
Range("O1").Select
ActiveCell.FormulaR1C1 = "CAT"
Calculate
Columns("L:L").Select
Selection.NumberFormat = "0"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'SIMD(10) CALCULATION
Range("M1").Select
ActiveCell.FormulaR1C1 = "SIMD(10)"
Range("M2").Select
ActiveCell.FormulaR1C1 = "=ROUNDUP((RC[1]/2),0)"
Range("M2").Select
Selection.AutoFill Destination:=Range("M2:M" & lnglastrow), Type:=xlFillDefault
Range("M2:M" & lnglastrow).Select
'REPOSITION GENDER
Columns(Left(Application.ThisWorkbook.Path, InStr(Application.ThisWorkbook.Path, ":") - 1) & ":P").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("P1").Select
ActiveCell.FormulaR1C1 = "GENDER)"
Range("P2").Select
ActiveCell.FormulaR1C1 = "=R[0]C[-8]"
Range("P2").Select
Selection.AutoFill Destination:=Range("P2:P" & lnglastrow), Type:=xlFillDefault
Range("P2:P" & lnglastrow).Select
'REPOSITION ADMISSION CODE
Range("AI1").Select
ActiveCell.FormulaR1C1 = "AD CODE)"
Range("AI2").Select
ActiveCell.FormulaR1C1 = "=R[0]C[-34]"
Range("AI2").Select
Selection.AutoFill Destination:=Range("AI2:AI" & lnglastrow), Type:=xlFillDefault
Range("AI2:AI" & lnglastrow).Select
Calculate
End With
'IMPORT BGE TRACKING DATA
ProgressBGE.Show
Sheets.Add Type:= _
Application.ThisWorkbook.Path & "\Source Reference Files\BGE Tracking Data.xlsx"
'FIND LAST ROW
lnglastrow = Cells(Rows.Count, "C").End(xlUp).Row
'INSERT COLUMN
Columns("F:F").Select
Range("F" & lnglastrow).Activate
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("E:E").Select
Range("E" & lnglastrow).Activate
Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, other:=True, OtherChar _
:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Cells.Select
'SORT DATA BY
Range("A1").Activate
ActiveWorkbook.Worksheets("Sheet1").SORT.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").SORT.SortFields.Add Key:=Range("E2:E" & lnglastrow _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").SORT.SortFields.Add Key:=Range("F2:F" & lnglastrow _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").SORT.SortFields.Add Key:=Range("A2:A" & lnglastrow _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").SORT.SortFields.Add Key:=Range("B2:B" & lnglastrow _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").SORT
.SetRange Range("A1:AZ" & lnglastrow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'GENERATE NAMES
Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],"" "",RC[-1])"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C" & lnglastrow), Type:=xlFillDefault
Range("C2:C" & lnglastrow).Select
Range("K2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-10],RC[-9],RC[-5],RC[-4])"
Range("K2").Select
Selection.AutoFill Destination:=Range("K2:K" & lnglastrow), Type:=xlFillDefault
' PROCESS TO DEAL WITH PUPILS WITH IDENTICAL NAMES [Ibrahim Queshi]
With Worksheets("Sheet1")
Sheets("Sheet1").Select
Sheets("Sheet1").name = "BGETrack1"
.Visible = True
End With
Dim DicBGE As Object: Set DicBGE = CreateObject("Scripting.Dictionary")
Set ws = Worksheets("BGETrack1")
For Each rCell In ws.Range("B1", ws.Cells(Rows.Count, "B").End(xlUp))
If rCell.Value Like "Qureshi" And rCell.Offset(columnoffset:=-1) Like "Ibrahim" And rCell.Offset(columnoffset:=2) Like "*B-CM" Then
DicBGE.Add (rCell.Value), Nothing
rCell.Select
ActiveCell.Value = "Qureshi [B]"
End If
Next rCell
For Each rCell In ws.Range("B1", ws.Cells(Rows.Count, "B").End(xlUp))
If rCell.Value Like "Qureshi" And rCell.Offset(columnoffset:=-1) Like "Ibrahim" And rCell.Offset(columnoffset:=2) Like "*E-RC" Then
DicBGE.Add (rCell.Value), Nothing
rCell.Select
ActiveCell.Value = "Qureshi [E]"
End If
Next rCell
With Worksheets("Sheet1")
Sheets("Sheet1").Select
Sheets("Sheet1").name = "BGETrack1"
.Visible = True
End With
With Worksheets("Sheet2")
Sheets("Sheet2").Select
Sheets("Sheet2").name = "BGETrack2"
.Visible = True
lnglastrow = Cells(Rows.Count, "C").End(xlUp).Row
Columns("F:F").Select
Range("F" & lnglastrow).Activate
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("E:E").Select
Range("E" & lnglastrow).Activate
Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, other:=True, OtherChar _
:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Cells.Select
Range("A1").Activate
ActiveWorkbook.Worksheets("Sheet1").SORT.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").SORT.SortFields.Add Key:=Range("E2:E" & lnglastrow _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").SORT.SortFields.Add Key:=Range("F2:F" & lnglastrow _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").SORT.SortFields.Add Key:=Range("A2:A" & lnglastrow _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").SORT.SortFields.Add Key:=Range("B2:B" & lnglastrow _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").SORT
.SetRange Range("A1:P" & lnglastrow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C1").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],"" "",RC[-1])"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C" & lnglastrow), Type:=xlFillDefault
Range("C1:C" & lnglastrow).Select
Columns("H:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H1").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-7], RC[-6], RC[-2],RC[-1])"
Range("H1").Select
Selection.AutoFill Destination:=Range("H1:H" & lnglastrow), Type:=xlFillDefault
Range("H1:H" & lnglastrow).Select
Set ws = Worksheets("BGETrack2")
For Each rCell In ws.Range("B1", ws.Cells(Rows.Count, "B").End(xlUp))
If rCell.Value Like "Qureshi" And rCell.Offset(columnoffset:=-1) Like "Ibrahim" And rCell.Offset(columnoffset:=2) Like "2B-CM" Then
DicBGE.Add (rCell.Value), Nothing
rCell.Select
ActiveCell.Value = "Qureshi [B]"
End If
Next rCell
For Each rCell In ws.Range("B1", ws.Cells(Rows.Count, "B").End(xlUp))
If rCell.Value Like "Qureshi" And rCell.Offset(columnoffset:=-1) Like "Ibrahim" And rCell.Offset(columnoffset:=2) Like "2E-RC" Then
DicBGE.Add (rCell.Value), Nothing
rCell.Select
ActiveCell.Value = "Qureshi [E]"
End If
Next rCell
End With
ProgressBGE.Show
'COPY DATA FROM TRACKPOINTS 2 & 3 OVER TO SHEET OF TRACKPOINT1
With Worksheets("BGETrack1")
.Activate
lnglastrow = Cells(Rows.Count, "C").End(xlUp).Row
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC11,BGETrack2!C8:C16,3,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC11,BGETrack2!C8:C16,3,FALSE)),"""",VLOOKUP(RC11,BGETrack2!C8:C16,3,FALSE)))"
Range("L2").Select
Selection.AutoFill Destination:=Range("L2:L" & lnglastrow), Type:=xlFillDefault
Range("L2:L" & lnglastrow).Select
Range("M2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC11,BGETrack2!C8:C16,4,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC11,BGETrack2!C8:C16,4,FALSE)),"""",VLOOKUP(RC11,BGETrack2!C8:C16,4,FALSE)))"
Range("M2").Select
Selection.AutoFill Destination:=Range("M2:M" & lnglastrow), Type:=xlFillDefault
Range("M2:M" & lnglastrow).Select
Range("N2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC11,BGETrack2!C8:C16,5,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC11,BGETrack2!C8:C16,5,FALSE)),"""",VLOOKUP(RC11,BGETrack2!C8:C16,5,FALSE)))"
Range("N2").Select
Selection.AutoFill Destination:=Range("N2:N" & lnglastrow), Type:=xlFillDefault
Range("N2:N" & lnglastrow).Select
Calculate
End With
With Worksheets("Sheet3")
Sheets("Sheet3").Select
Sheets("Sheet3").name = "BGETrack3"
.Visible = True
End With
With Worksheets("BGETrack3")
.Activate
'find last filled row
lnglastrow = Cells(Rows.Count, "C").End(xlUp).Row
'insert a column C and fill with concatenated name
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],"" "",RC[-1])"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E" & lnglastrow), Type:=xlFillDefault
Range("E2:E" & lnglastrow).Select
Calculate
Columns("G:G").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("G2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],"" "",RC[-6])"
Range("G2").Select
Selection.AutoFill Destination:=Range("G2:G" & lnglastrow), Type:=xlFillDefault
Range("G2:G" & lnglastrow).Select
Calculate
Set ws = Worksheets("BGETrack3")
' PROCESS TO DEAL WITH PUPILS WITH IDENTICAL NAMES [Ibrahim Queshi]
For Each rCell In ws.Range("B1", ws.Cells(Rows.Count, "B").End(xlUp))
If rCell.Value Like "Qureshi" And rCell.Offset(columnoffset:=-1) Like "Ibrahim" And rCell.Offset(columnoffset:=2) Like "2B-CM" Then
DicBGE.Add (rCell.Value), Nothing
rCell.Select
ActiveCell.Value = "Qureshi [B]"
End If
Next rCell
For Each rCell In ws.Range("B1", ws.Cells(Rows.Count, "B").End(xlUp))
If rCell.Value Like "Qureshi" And rCell.Offset(columnoffset:=-1) Like "Ibrahim" And rCell.Offset(columnoffset:=2) Like "2E-RC" Then
DicBGE.Add (rCell.Value), Nothing
rCell.Select
ActiveCell.Value = "Qureshi [E]"
End If
Next rCell
End With
With Worksheets("BGETrack1")
.Activate
'find last filled row
lnglastrow = Cells(Rows.Count, "C").End(xlUp).Row
Range("Q2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC3&"" ""&RC1,BGETrack3!C7:C16,5,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3&"" ""&RC1,BGETrack3!C7:C16,5,FALSE)),"""",VLOOKUP(RC3&"" ""&RC1,BGETrack3!C7:C16,5,FALSE)))"
Range("Q2").Select
Selection.AutoFill Destination:=Range("Q2:Q" & lnglastrow), Type:=xlFillDefault
Range("Q2:Q" & lnglastrow).Select
Range("r2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC3&"" ""&RC1,BGETrack3!C7:C16,6,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3&"" ""&RC1,BGETrack3!C7:C16,6,FALSE)),"""",VLOOKUP(RC3&"" ""&RC1,BGETrack3!C7:C16,6,FALSE)))"
Range("r2").Select
Selection.AutoFill Destination:=Range("r2:r" & lnglastrow), Type:=xlFillDefault
Range("r2:r" & lnglastrow).Select
Range("s2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC3&"" ""&RC1,BGETrack3!C7:C16,7,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3&"" ""&RC1,BGETrack3!C7:C16,7,FALSE)),"""",VLOOKUP(RC3&"" ""&RC1,BGETrack3!C7:C16,7,FALSE)))"
Range("s2").Select
Selection.AutoFill Destination:=Range("s2:s" & lnglastrow), Type:=xlFillDefault
Range("s2:s" & lnglastrow).Select
Calculate
End With
'IMPORT SENIOR TRACKING DATA
Sheets.Add Type:= _
Application.ThisWorkbook.Path & "\Source Reference Files\SP Tracking Data.xlsx"
With Worksheets("Sheet2")
Sheets("Sheet2").Select
Sheets("Sheet2").name = "SPTrack2"
.Visible = True
End With
With Worksheets("Sheet3")
Sheets("Sheet3").Select
Sheets("Sheet3").name = "SPTrack3"
.Visible = True
End With
With Worksheets("Sheet4")
Sheets("Sheet4").Select
Sheets("Sheet4").name = "SPTrack4"
.Visible = True
End With
ProgressSP.Show
On Error Resume Next
With Worksheets("Sheet1")
.Activate
'find last filled row
lnglastrow = Cells(Rows.Count, "C").End(xlUp).Row
'insert a column C and fill with concatenated name
Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[1],"" "",RC[2])"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C" & lnglastrow), Type:=xlFillDefault
Range("C2:C" & lnglastrow).Select
Calculate
'insert 2 columns and split reg into year and class group
'switch off warnings
Columns("G:H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("F:F").Select
Selection.TextToColumns Destination:=Range("F1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(1, 1), Array(2, 1)), TrailingMinusNumbers:= _
True
Columns("H:H").Select
Selection.ClearContents
'switch warnings back on
'Copy/ paste column C as values
'Delete columns D & E
Columns("C:C").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("D:E").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
'prepare course data to more useful form
'separate course code from description
Columns("A:A").Select
Selection.Copy
Columns("F:F").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("A:A").Select
Selection.Copy
Columns("G:G").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("G:G").Select
Selection.TextToColumns Destination:=Range("G1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(4, 1)), TrailingMinusNumbers:=True
'insert two columns
Columns("I:J").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("I2").Select
ActiveCell.FormulaR1C1 = "=if"
Range("H2").Select
RowCount = WorksheetFunction.CountA(Range("A:A"))
For i = 2 To RowCount
myString = Trim(Cells(i, 1).Value)
If InStr(myString, "HIGH") > 0 Then
Cells(i, 9).Value = "HIGH"
End If
Next
For i = 2 To RowCount
myString = Trim(Cells(i, 1).Value)
If InStr(myString, "ADVH") > 0 Then
Cells(i, 9).Value = "ADVH"
End If
Next
For i = 2 To RowCount
myString = Trim(Cells(i, 1).Value)
If InStr(myString, "NAT5") > 0 Then
Cells(i, 9).Value = "NAT5"
End If
Next
For i = 2 To RowCount
myString = Trim(Cells(i, 1).Value)
If InStr(myString, "NAT4") > 0 Then
Cells(i, 9).Value = "NAT4"
End If
Next
For i = 2 To RowCount
myString = Trim(Cells(i, 1).Value)
If InStr(myString, "NAT3") > 0 Then
Cells(i, 9).Value = "NAT3"
End If
Next
For i = 2 To RowCount
myString = Trim(Cells(i, 1).Value)
If InStr(myString, "ADVH") > 0 Then
Cells(i, 9).Value = "ADVH"
End If
Next
End With
With Worksheets("Sheet1")
Sheets("Sheet1").Select
Sheets("Sheet1").name = "SPTrack1"
End With
' PROCESS TO DEAL WITH PUPILS WITH IDENTICAL NAMES [Ibrahim Queshi] can be copied for SPTrack2/3
Set ws = Worksheets("SPTrack1")
For Each rCell In ws.Range("C1", ws.Cells(Rows.Count, "C").End(xlUp))
If rCell.Value Like "Ibrahim Qureshi" And rCell.Offset(columnoffset:=1) Like "SCN Number Here" Then
DicBGE.Add (rCell.Value), Nothing
rCell.Select
ActiveCell.Value = "Qureshi [B]"
End If
Next rCell
For Each rCell In ws.Range("C1", ws.Cells(Rows.Count, "C").End(xlUp))
If rCell.Value Like "Ibrahim Qureshi" And rCell.Offset(columnoffset:=1) Like "SCN NUmber Here" Then
DicBGE.Add (rCell.Value), Nothing
rCell.Select
ActiveCell.Value = "Qureshi [E]"
End If
Next rCell
ProgressSP.Show
With Worksheets("SPTrack2")
.Activate
'find last filled row
lnglastrow = Cells(Rows.Count, "C").End(xlUp).Row
'insert a column C and fill with concatenated name
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],"" "",RC[-1])"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E" & lnglastrow), Type:=xlFillDefault
Range("E2:E" & lnglastrow).Select
Calculate
Columns("G:G").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("G2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],"" "",RC[-6])"
Range("G2").Select
Selection.AutoFill Destination:=Range("G2:G" & lnglastrow), Type:=xlFillDefault
Range("G2:G" & lnglastrow).Select
Calculate
End With
With Worksheets("SPTrack1")
.Activate
'find last filled row
lnglastrow = Cells(Rows.Count, "C").End(xlUp).Row
Range("Q2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC3&"" ""&RC1,SPTrack2!C7:C16,5,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3&"" ""&RC1,SPTrack2!C7:C16,5,FALSE)),"""",VLOOKUP(RC3&"" ""&RC1,SPTrack2!C7:C16,5,FALSE)))"
Range("Q2").Select
Selection.AutoFill Destination:=Range("Q2:Q" & lnglastrow), Type:=xlFillDefault
Range("Q2:Q" & lnglastrow).Select
Range("r2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC3&"" ""&RC1,SPTrack2!C7:C16,6,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3&"" ""&RC1,SPTrack2!C7:C16,6,FALSE)),"""",VLOOKUP(RC3&"" ""&RC1,SPTrack2!C7:C16,6,FALSE)))"
Range("r2").Select
Selection.AutoFill Destination:=Range("r2:r" & lnglastrow), Type:=xlFillDefault
Range("r2:r" & lnglastrow).Select
Range("s2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC3&"" ""&RC1,SPTrack2!C7:C16,7,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3&"" ""&RC1,SPTrack2!C7:C16,7,FALSE)),"""",VLOOKUP(RC3&"" ""&RC1,SPTrack2!C7:C16,7,FALSE)))"
Range("s2").Select
Selection.AutoFill Destination:=Range("s2:s" & lnglastrow), Type:=xlFillDefault
Range("s2:s" & lnglastrow).Select
Range("t2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC3&"" ""&RC1,SPTrack2!C7:C16,8,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3&"" ""&RC1,SPTrack2!C7:C16,8,FALSE)),"""",VLOOKUP(RC3&"" ""&RC1,SPTrack2!C7:C16,8,FALSE)))"
Range("t2").Select
Selection.AutoFill Destination:=Range("t2:t" & lnglastrow), Type:=xlFillDefault
Range("t2:t" & lnglastrow).Select
Calculate
End With
ProgressSP.Show
With Worksheets("SPTrack3")
.Activate
'find last filled row
lnglastrow = Cells(Rows.Count, "C").End(xlUp).Row
'insert a column C and fill with concatenated name
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],"" "",RC[-1])"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E" & lnglastrow), Type:=xlFillDefault
Range("E2:E" & lnglastrow).Select
Calculate
Columns("G:G").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("G2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],"" "",RC[-6])"
Range("G2").Select
Selection.AutoFill Destination:=Range("G2:G" & lnglastrow), Type:=xlFillDefault
Range("G2:G" & lnglastrow).Select
Calculate
End With
With Worksheets("SPTrack1")
.Activate
'find last filled row
lnglastrow = Cells(Rows.Count, "C").End(xlUp).Row
Range("U2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC3&"" ""&RC1,SPTrack3!C7:C16,5,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3&"" ""&RC1,SPTrack3!C7:C16,5,FALSE)),"""",VLOOKUP(RC3&"" ""&RC1,SPTrack3!C7:C16,5,FALSE)))"
Range("u2").Select
Selection.AutoFill Destination:=Range("u2:u" & lnglastrow), Type:=xlFillDefault
Range("u2:u" & lnglastrow).Select
Range("v2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC3&"" ""&RC1,SPTrack3!C7:C16,6,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3&"" ""&RC1,SPTrack3!C7:C16,6,FALSE)),"""",VLOOKUP(RC3&"" ""&RC1,SPTrack3!C7:C16,6,FALSE)))"
Range("v2").Select
Selection.AutoFill Destination:=Range("v2:v" & lnglastrow), Type:=xlFillDefault
Range("v2:v" & lnglastrow).Select
Range("w2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC3&"" ""&RC1,SPTrack3!C7:C16,7,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3&"" ""&RC1,SPTrack3!C7:C16,7,FALSE)),"""",VLOOKUP(RC3&"" ""&RC1,SPTrack3!C7:C16,7,FALSE)))"
Range("w2").Select
Selection.AutoFill Destination:=Range("w2:w" & lnglastrow), Type:=xlFillDefault
Range("w2:w" & lnglastrow).Select
Range("x2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC3&"" ""&RC1,SPTrack3!C7:C16,8,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3&"" ""&RC1,SPTrack3!C7:C16,8,FALSE)),"""",VLOOKUP(RC3&"" ""&RC1,SPTrack3!C7:C16,8,FALSE)))"
Range("x2").Select
Selection.AutoFill Destination:=Range("x2:x" & lnglastrow), Type:=xlFillDefault
Range("x2:x" & lnglastrow).Select
Calculate
End With
With Worksheets("SPTrack4")
.Activate
'find last filled row
lnglastrow = Cells(Rows.Count, "C").End(xlUp).Row
'insert a column C and fill with concatenated name
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],"" "",RC[-1])"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E" & lnglastrow), Type:=xlFillDefault
Range("E2:E" & lnglastrow).Select
Calculate
Columns("G:G").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("G2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],"" "",RC[-6])"
Range("G2").Select
Selection.AutoFill Destination:=Range("G2:G" & lnglastrow), Type:=xlFillDefault
Range("G2:G" & lnglastrow).Select
Calculate
End With
With Worksheets("SPTrack1")
.Activate
'find last filled row
lnglastrow = Cells(Rows.Count, "C").End(xlUp).Row
Range("AC2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC3&"" ""&RC1,SPTrack4!C7:C16,5,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3&"" ""&RC1,SPTrack4!C7:C16,5,FALSE)),"""",VLOOKUP(RC3&"" ""&RC1,SPTrack4!C7:C16,5,FALSE)))"
Range("AC2").Select
Selection.AutoFill Destination:=Range("AC2:AC" & lnglastrow), Type:=xlFillDefault
Range("AC2:AC" & lnglastrow).Select
Range("AD2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC3&"" ""&RC1,SPTrack4!C7:C16,6,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3&"" ""&RC1,SPTrack4!C7:C16,6,FALSE)),"""",VLOOKUP(RC3&"" ""&RC1,SPTrack4!C7:C16,6,FALSE)))"
Range("AD2").Select
Selection.AutoFill Destination:=Range("AD2:AD" & lnglastrow), Type:=xlFillDefault
Range("AD2:AD" & lnglastrow).Select
Range("AE2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC3&"" ""&RC1,SPTrack4!C7:C16,7,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3&"" ""&RC1,SPTrack4!C7:C16,7,FALSE)),"""",VLOOKUP(RC3&"" ""&RC1,SPTrack4!C7:C16,7,FALSE)))"
Range("AE2").Select
Selection.AutoFill Destination:=Range("AE2:AE" & lnglastrow), Type:=xlFillDefault
Range("AE2:AE" & lnglastrow).Select
Range("AF2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC3&"" ""&RC1,SPTrack4!C7:C16,8,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3&"" ""&RC1,SPTrack4!C7:C16,8,FALSE)),"""",VLOOKUP(RC3&"" ""&RC1,SPTrack4!C7:C16,8,FALSE)))"
Range("AF2").Select
Selection.AutoFill Destination:=Range("AF2:AF" & lnglastrow), Type:=xlFillDefault
Range("AF2:AF" & lnglastrow).Select
Range("AG2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C8,3,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C8,3,FALSE)),,VLOOKUP(RC3,SEEMIS_RCRDS!C6:C8,3,FALSE)))"
Selection.AutoFill Destination:=Range("AG2:AG" & lnglastrow), Type:=xlFillDefault
Range("AG2:AG" & lnglastrow).Select
Calculate
End With
ProgressSQA.Show
Dim LastRow As Long
'IMPORT SQA RESULTS FROM SEEMIS - DISPLAYED IN ASN FORMS
Sheets.Add Type:= _
Application.ThisWorkbook.Path & "\Source Reference Files\SQA_ASN.xlsx"
With Worksheets("Sheet2")
.Delete
End With
With Worksheets("Sheet3")
.Delete
End With
With Worksheets("Sheet1")
.Activate
lnglastrow = Cells(Rows.Count, "C").End(xlUp).Row
Sheets("Sheet1").name = "SQA"
Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C1").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],"" "",RC[-1])"
Range("C2").Select
Columns("C:C").EntireColumn.AutoFit
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C" & lnglastrow), Type:=xlFillDefault
Range("C1:C13").Select
Columns("F:F").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("F1").Select
Sheets("SIMD").Visible = True
Sheets("SQA").Select
Range("F1").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-3],SEEMIS_RCRDS!C[-2]:C[3],6,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC[-3],SEEMIS_RCRDS!C[-2]:C[3],6,FALSE)),"""",VLOOKUP(RC[-3],SEEMIS_RCRDS!C[-2]:C[3],6,FALSE)))"
Range("F1").Select
Selection.AutoFill Destination:=Range("F1:F" & lnglastrow), Type:=xlFillDefault
Range("F1:F13").Select
End With
With Worksheets("Reports")
.Visible = False
End With
With Worksheets("UCASRecord")
.Visible = False
End With
'WRITE TO LOG FILE
Open Left(Application.ThisWorkbook.Path, InStr(Application.ThisWorkbook.Path, ":") - 1) & ":\Pupil Recognition\Files\Spreadsheet Logs\ASN Database\Usage logs\ASN Database Use.log" For Append As #1
Print #1, Application.UserName, "Opened", Date, Time
Close #1
'DISPLAY DATA ENTRY FORM (HOME PAGE)
With Worksheets("Data Entry")
.Visible = True
Range("a1").Select
End With
'HIDE UNUSED SHEETS
With Worksheets("TempRpt")
.Visible = False
End With
With Worksheets("TempAct")
.Visible = False
End With
With Worksheets("RoundRobin")
.Visible = False
End With
With Worksheets("RoundRobinTmp")
.Visible = False
End With
With Worksheets("SPTrack")
.Visible = False
End With
With Worksheets("SQA")
.Visible = False
End With
With Worksheets("RepotsA")
.Visible = False
End With
With Worksheets("ReportsB")
.Visible = False
End With
With Worksheets("ReportsC")
.Visible = False
End With
With Worksheets("CATPredictions")
.Visible = False
End With
With Worksheets("DofE")
.Visible = False
End With
With Worksheets("Diagnoses")
.Visible = False
End With
With Worksheets("Records")
.Visible = False
End With
With Worksheets("ASNLists")
.Visible = False
End With
With Worksheets("UCASList")
.Visible = False
End With
With Worksheets("TrackData")
.Visible = False
End With
With Worksheets("UCASRequests")
.Visible = False
End With
With Worksheets("CAT")
.Visible = False
End With
With Worksheets("ReportsTF")
.Visible = False
End With
With Worksheets("UCASList")
.Visible = False
End With
With Worksheets("SEEMIS_RCRDS")
.Visible = False
End With
With Worksheets("SPTrack1")
.Visible = False
End With
With Worksheets("SPTrack2")
.Visible = False
End With
With Worksheets("SPTrack3")
.Visible = False
End With
With Worksheets("SPTrack4")
.Visible = False
End With
With Worksheets("BGETrack1")
.Visible = False
End With
With Worksheets("BGETrack2")
.Visible = False
End With
With Worksheets("TrackData2")
.Visible = False
End With
With Worksheets("BGETrack3")
.Visible = False
End With
With Worksheets("ReportsATTND")
.Visible = False
End With
With Worksheets("SQA_Anlys")
.Visible = False
End With
With Worksheets("Post16")
.Visible = False
End With
With Worksheets("ReportsA")
.Visible = False
End With
With Worksheets("ReportsHB")
.Visible = False
End With
With Worksheets("ReportsTF")
.Visible = False
End With
With Worksheets("SQA_CLS")
.Visible = False
End With
ProgressASN.Show
'UPDATE PUPIL DATA ON ASNLists SHEETS - REFRESHING SIMD, GENDER, CAT & REGISTRATION DATA. INCORPORATE IMAGE CODE [PUPIL ADMISSION CODE]
With Worksheets("ASNLists")
.Activate
.Visible
lnglastrow = Cells(Rows.Count, "E").End(xlUp).Row
lnglastrow = lnglastrow + 100
'SIMD
Range("AA3").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC5,SEEMIS_RCRDS!C5:C13,9,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC5,SEEMIS_RCRDS!C5:C13,9,FALSE)),"""",VLOOKUP(RC5,SEEMIS_RCRDS!C5:C13,9,FALSE)))"
Selection.AutoFill Destination:=Range("AA3:AA" & lnglastrow), Type:=xlFillDefault
Range("AA3:AA" & lnglastrow).Select
Calculate
Columns("AA:AA").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'GENDER
Range("S3").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC5,SEEMIS_RCRDS!C5:C8,4,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC5,SEEMIS_RCRDS!C5:C8,4,FALSE)),"""",VLOOKUP(RC5,SEEMIS_RCRDS!C5:C8,4,FALSE)))"
Selection.AutoFill Destination:=Range("S3:S" & lnglastrow), Type:=xlFillDefault
Range("S3:S" & lnglastrow).Select
Calculate
Columns("S:S").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'REG
Range("H3").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC5,SEEMIS_RCRDS!C5:C18,5,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC5,SEEMIS_RCRDS!C5:C18,5,FALSE)),"""",VLOOKUP(RC5,SEEMIS_RCRDS!C5:C18,5,FALSE)))"
Selection.AutoFill Destination:=Range("H3:H" & lnglastrow), Type:=xlFillDefault
Range("H3:H" & lnglastrow).Select
Calculate
Columns("H:H").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'PTPC
Range("I3").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC5,SEEMIS_RCRDS!C5:C18,6,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC5,SEEMIS_RCRDS!C5:C18,6,FALSE)),"""",VLOOKUP(RC5,SEEMIS_RCRDS!C5:C18,6,FALSE)))"
Selection.AutoFill Destination:=Range("I3:I" & lnglastrow), Type:=xlFillDefault
Range("I3:I" & lnglastrow).Select
Calculate
Columns("I:I").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'CAT
Range("T3").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC5,SEEMIS_RCRDS!C5:C15,11,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC5,SEEMIS_RCRDS!C5:C15,11,FALSE)),"""",VLOOKUP(RC5,SEEMIS_RCRDS!C5:C15,11,FALSE)))"
Selection.AutoFill Destination:=Range("t3:t" & lnglastrow), Type:=xlFillDefault
Range("t3:t" & lnglastrow).Select
Calculate
Columns("t:t").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Practical SET
Range("AD3").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC5,SEEMIS_RCRDS!C5:C15,6,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC5,SEEMIS_RCRDS!C5:C15,6,FALSE)),"""",VLOOKUP(RC5,SEEMIS_RCRDS!C5:C15,6,FALSE)))"
Selection.AutoFill Destination:=Range("AD3:AD" & lnglastrow), Type:=xlFillDefault
Range("AD3:AD" & lnglastrow).Select
Calculate
Columns("AD:AD").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'IMAGE
Range("U3").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC5,SEEMIS_RCRDS!C5:C50,31,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC5,SEEMIS_RCRDS!C5:C50,31,FALSE)),"""",VLOOKUP(RC5,SEEMIS_RCRDS!C5:C50,31,FALSE)))"
Selection.AutoFill Destination:=Range("U3:U" & lnglastrow), Type:=xlFillDefault
Range("U3:U" & lnglastrow).Select
Calculate
Columns("U:U").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Calculate
Sheets("Data Entry").Select
End With
'IMPORT ADDITIONAL DATA INTO SENIOR TRACK DATA
With Worksheets("SPTrack1")
.Activate
.Visible
lnglastrow = Cells(Rows.Count, "C").End(xlUp).Row
'GET SQA CANDIDIATE NUMBER
Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveWindow.ScrollColumn = 2
Range("D2").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C13,7,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C13,7,FALSE)),"""",VLOOKUP(RC3,SEEMIS_RCRDS!C6:C13,7,FALSE)))"
Selection.AutoFill Destination:=Range("D2:D" & lnglastrow), Type:=xlFillDefault
Range("D2:D" & lnglastrow).Select
Calculate
'GET CAT VALUES
Range("L2").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,10,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,10,FALSE)),"""",VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,10,FALSE)))"
Selection.AutoFill Destination:=Range("L2:L" & lnglastrow), Type:=xlFillDefault
Range("L2:L" & lnglastrow).Select
Calculate
'GET SIMD VALUES
Range("K2").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C13,8,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C13,8,FALSE)),"""",VLOOKUP(RC3,SEEMIS_RCRDS!C6:C13,8,FALSE)))"
Selection.AutoFill Destination:=Range("K2:K" & lnglastrow), Type:=xlFillDefault
Range("K2:K" & lnglastrow).Select
Calculate
'GET AVG ATT VALUES
Range("Z2").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,26,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,26,FALSE)),"""",VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,26,FALSE)))"
Selection.AutoFill Destination:=Range("Z2:Z" & lnglastrow), Type:=xlFillDefault
Range("Z2:Z" & lnglastrow).Select
Calculate
'GET AM LATES VALUES
Range("AA2").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,27,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,27,FALSE)),"""",VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,27,FALSE)))"
Selection.AutoFill Destination:=Range("AA2:AA" & lnglastrow), Type:=xlFillDefault
Range("AA2:AA" & lnglastrow).Select
Calculate
'GET ABSENCES VALUES
Range("AB2").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,29,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,29,FALSE)),"""",VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,29,FALSE)))"
Selection.AutoFill Destination:=Range("AB2:AB" & lnglastrow), Type:=xlFillDefault
Range("AB2:AB" & lnglastrow).Select
Calculate
Sheets("SPTrack1").Select
Range("C1").Select
ActiveCell.Value = "Tracking Name"
Range("D1").Select
ActiveCell.Value = "Pupil"
Range("E1").Select
ActiveCell.Value = "Year"
Range("F1").Select
ActiveCell.Value = "Reg"
Range("H1").Select
ActiveCell.Value = "CourseCode"
Range("I1").Select
ActiveCell.Value = "Course"
Range("J1").Select
ActiveCell.Value = "Level"
Range("K1").Select
ActiveCell.Value = "SIMD"
Range("L1").Select
ActiveCell.Value = "CAT"
Range("M1").Select
Range("r1").Select
ActiveCell.Value = "Trck Gd2"
Range("s1").Select
ActiveCell.Value = "Eff 2"
Range("t1").Select
ActiveCell.Value = "Beh 2"
Range("u1").Select
ActiveCell.Value = "Hwrk 2"
Range("v1").Select
ActiveCell.Value = "Trck Gd3"
Range("w1").Select
ActiveCell.Value = "Eff 3"
Range("x1").Select
ActiveCell.Value = "Beh 3"
Range("y1").Select
ActiveCell.Value = "Hwrk 3"
Range("y1").Select
Calculate
End With
'IMPORT ADDITIONAL DATA INTO BGE TRACK DATA
With Worksheets("BGETrack1")
.Activate
.Visible
lnglastrow = Cells(Rows.Count, "C").End(xlUp).Row
'GET CAT VALUES
Range("Z1").Select
ActiveCell.Value = "CAT"
Range("Z2").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,10,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,10,FALSE)),"""",VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,10,FALSE)))"
Selection.AutoFill Destination:=Range("Z2:Z" & lnglastrow), Type:=xlFillDefault
Range("Z2:Z" & lnglastrow).Select
Calculate
'GET SIMD VALUES
Range("AA1").Select
ActiveCell.Value = "SIMD"
Range("AA2").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,8,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,8,FALSE)),"""",VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,8,FALSE)))"
Selection.AutoFill Destination:=Range("AA2:AA" & lnglastrow), Type:=xlFillDefault
Range("AA2:AA" & lnglastrow).Select
Calculate
'GET AVG ATT VALUES
Range("AB1").Select
ActiveCell.Value = "ATT"
Range("AB2").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,26,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,26,FALSE)),"""",VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,26,FALSE)))"
Selection.AutoFill Destination:=Range("AB2:AB" & lnglastrow), Type:=xlFillDefault
Range("AB2:AB" & lnglastrow).Select
Calculate
'GET AM LATES VALUES
Range("AC1").Select
ActiveCell.Value = "AM LATES"
Range("AC2").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,27,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,27,FALSE)),"""",VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,27,FALSE)))"
Selection.AutoFill Destination:=Range("AC2:AC" & lnglastrow), Type:=xlFillDefault
Range("AC2:AC" & lnglastrow).Select
Calculate
'GET ABSENCES VALUES
Range("AD1").Select
ActiveCell.Value = "ABS"
Range("AD2").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,29,FALSE)),"""",IF(ISBLANK(VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,29,FALSE)),"""",VLOOKUP(RC3,SEEMIS_RCRDS!C6:C40,29,FALSE)))"
Selection.AutoFill Destination:=Range("AD2:AD" & lnglastrow), Type:=xlFillDefault
Range("AD2:AD" & lnglastrow).Select
Calculate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
Progress.Show
lastsavedtimestamp = ActiveWorkbook.BuiltinDocumentProperties("Last Save Time")
With Worksheets("Data Entry")
.Protect
.Visible = True
.Activate
Dim TextboxName As String
Dim TextboxText As String
lastsavedtimestamp = ActiveWorkbook.BuiltinDocumentProperties("Last Save Time")
TextboxName = "TextBox 12"
TextboxText = "PROGRAM RELEASE: " & lastsavedtimestamp
ActiveSheet.Shapes(TextboxName).DrawingObject.Text = TextboxText
End With
With Worksheets("SPtrack1")
.Activate
Calculate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.Visible = False
End With
Sheets("Data Entry").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
|
||
