I've created a macro that takes a master spreadsheet, and creates a new spreadsheet for each school listed in the table. I just got a new laptop and installed Excel 365 on it. I copied the VBA code to the new machine, but when I ran it, each new worksheet still contained the data for all the schools, not just the school for that particular file. I stepped through the code, and the schools did delete, but when it got to the part where the filter was removed from the table (ws.ListObjects("Data").AutoFilter.ShowAllData), all the schools reappeared. I'm stumped on why this is happening - It didn't happen on the other two machines and other iterations of the file that I've used this macro on. I don't know if it's an Excel setting or a setting on this particular master file. The other two machines - one used Excel 365, and the other Excel 2016.
VBA Code:
Sub CreateGalileoSchoolFiles()
Dim i As Integer, wb As Workbook, schools() As Variant, schools_to_delete() As Variant
Dim ws As Worksheet, rng As Range, dt As String
schools = SchoolsInList()
dt = MonthName(Month(Now)) & " " & Year(Now)
Set wb = ActiveWorkbook
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
For i = 1 To UBound(schools)
wb.SaveCopyAs ("Galileo " & dt & " " & schools(i) & ".xlsx")
Workbooks.Open ("Galileo " & dt & " " & schools(i) & ".xlsx")
Workbooks("Galileo " & dt & " " & schools(i) & ".xlsx").Activate
Set ws = Sheets("Data")
ws.Activate
schools_to_delete = schools
schools_to_delete(i) = "x"
Set rng = ws.ListObjects("Data").DataBodyRange
With ws
.AutoFilterMode = False
ws.ListObjects("Data").Range.AutoFilter Field:=18, Criteria1:= _
Array(schools_to_delete), Operator:=xlFilterValues
ws.Range(rng.Address).SpecialCells(xlCellTypeVisible).Delete
.AutoFilterMode = False
ws.ListObjects("Data").AutoFilter.ShowAllData
End With
ActiveWorkbook.RefreshAll
Call SelectA1
ActiveWorkbook.Save
ActiveWorkbook.Close
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
End Sub
Function SchoolsInList() As Variant
Dim schools() As String
Dim C As Collection
Dim r As Range
Dim i As Long
Dim last_row As Long
last_row = Cells(Rows.Count, 1).End(xlUp).Row
Set C = New Collection
On Error Resume Next
For Each r In Worksheets("Data").Range("R2:R" & last_row).Cells
C.Add r.Value, CStr(r.Value)
Next
On Error GoTo 0
ReDim A(1 To C.Count)
For i = 1 To C.Count
A(i) = C.Item(i)
Next i
SchoolsInList = A
End Function
Sub SelectA1()
Dim i As Long
For i = 1 To ActiveWorkbook.Sheets.Count
Sheets(i).Activate
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
Range("A1").Select
Next i
ActiveWorkbook.Worksheets(2).Activate
End Sub