I've been working on the following VBA code for Excel. It updates a "DATA" sheet of about 12,800 records with fresh information pasted into the sheet "Update2", while retaining any records which an update is not available for. This is for a university department, so its intended use is to be run once or twice a year as a records update.
This currently is taking 2m10s to run, and I'd appreciate any guidance. I've tried a few things (as you can see) but I'm reaching the end of my ability. Thanks.
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.StatusBar = "Please wait. Updating records."
Sheets("Update2").Select
'The lines below delete the the rows where regnum is zero and the header row.
On Error Resume Next
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$G$12231").AutoFilter Field:=1, Criteria1:="0"
Dim LastZero As Long
LastZero = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:G" & LastZero).Select
Selection.EntireRow.Delete
ActiveSheet.Range("$A$1:$G$12152").AutoFilter Field:=1
If Err Then
'do nothing. This ignores a case where there are no rows where regnum is zero.
End If
Range("A1:G1").Select
Selection.Delete Shift:=xlUp
Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("A1:G" & LastRow).Select
Selection.Copy
Sheets("DATA").Select
Range("A2:G2").Select
Selection.Insert Shift:=xlDown
Columns("A:J").Select
ActiveSheet.Range("A:J").RemoveDuplicates Columns:=1, Header:=xlYes
'This removes duplicate regnums.
'Unfortunately, this breaks all the formulae. Solutions welcome.
'What follows is a trudging rewrite of each formula.
Range("H2").Select
ActiveCell = "=INDEX($M$2:$M$10, MATCH((LEFT($F2,1)),$L$2:$L$10,0))"
Range("I2").Select
ActiveCell = [redacted]
'An INDEX-MATCH referring to another spreadsheet in the same folder.
Range("J2").Select
ActiveCell = "=INDEX(S:S, MATCH($C2,R:R,0))"
Dim LastData As Long
LastData = Range("A" & Rows.Count).End(xlUp).Row
Range("H2:J2").Copy Range("H2:J" & LastData)
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = "Update complete."