Excel Worksheet Split - vba

Question

So I need a bit of help with an existing macro.
I need to split a workbook's multiple worksheets into multiple files (not based on worksheet name).
The project: It deals with very sensitive HR/performance data, and I need to send 1000s of employees' data to their individual managers (about 100 managers who can only see their team's data, and no one else's), so I need about 100 files split (1 for each manager).
The file:
- Many different tabs, separated by role.
- First column is a unique identifier made by concatenating the Manager's name with the job title ex. John Stevens_Office Manager
The task: John Stevens will have team members in many different job roles, and needs all that data in one file, separated into tabs by job role. My current macro does half of this (splits the file, but does not unite).
It also doesn't delete out the other tabs from the file...and its a big file with about 50 tabs. Even just some help deleting the other tabs would be greatly appreciated. Also, the data is populated via VLookup, and every time it splits a file it gives me a message asking if I want to update the links? Can the updates be turned on permanently so it splits without any manual input?
Below is some sample data. Please keep in mind that the actual file is far more complex (at least 50 columns)
Sample Data
Sub SplitWB()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ActiveWorkbook.Save
Dim OutputFolderName As String
OutputFolderName = ""
Set myDlg = Application.FileDialog(msoFileDialogFolderPicker)
myDlg.AllowMultiSelect = False
myDlg.Title = "Select Output Folder for Touchstone Files:"
If myDlg.Show = -1 Then OutputFolderName = myDlg.SelectedItems(1) & "\" Else Exit Sub
Set myDlg = Nothing
Application.CutCopyMode = False
'''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''
Dim d As Object, c As range, k, tmp As String, unique(500)
i = 0
With ActiveSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Set d = CreateObject("scripting.dictionary")
For Each c In range(Cells(1, 1), Cells(lastRow, 1))
tmp = Trim(c.Value)
If Len(tmp) > 0 Then d(tmp) = d(tmp) + 1
Next c
For Each k In d.keys
Debug.Print k, d(k)
i = i + 1
unique(i) = k
Next k
UniqueCount = i
'start deleting
For i = 1 To UniqueCount
'Actions for new workbook
wpath = Application.ActiveWorkbook.FullName
wbook = ActiveWorkbook.Name
wsheet = ActiveSheet.Name
ActiveWorkbook.SaveAs Filename:=OutputFolderName & unique(i), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
For j = 1 To lastRow
If range("A" & j) <> "" And range("A" & j) <> unique(i) Then
Rows(j).Delete
j = j - 1
End If
Next
'hide helper columns
' If HideC = False And DeleteC = True Then
Columns("A:D").Hidden = True
' End If
'
range("E8").Select
'Select Instructions tab
'Worksheets("Guidelines").Activate
'Save new workbook
ActiveWorkbook.Close SaveChanges:=True
Workbooks.Open (wpath)
'ActiveWorkbook.Close False
Workbooks(wbook).Activate
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox ("Macro has completed successfully!" & vbNewLine & vbNewLine & "Generated files can be found in the following directory:" & vbNewLine & OutputFolderName)
End Sub
Thank you! Have a great day!

Answer 1

Partial Answer: Put this at the top of your code: application.AskToUpdateLinks = False and this at the end application.AskToUpdateLinks = true.

Answer 2

So i think you have a lot of extra code that may not be needed. i'm going to start out small b/c i'm not sure i fully understand the task at hand.
First, i'm going to create an array for all names in column A. Next, i'm going to iterate through the array just for the unique values
Sub SplitWB()
Dim namesArray As Variant
Dim uniqueDict As New dictionary
namesArray = Range("a1:a4") 'hardcoded the range for now
Set uniqueDict = New dictionary
For x = LBound(namesArray) To UBound(namesArray)
If Not uniqueDict.Exists(x) Then uniqueDict.Add x, namesArray (x, 1)
Next x
End Sub
The above may not do anything for you just yet, but i notice you're doing unique for loops, etc which aren't necessary. Just trying to condense your code for ease of debugging.
Once you respond to this, we can work on the next part (you may want to update your code if you use my solution above to create a unique dictionary)