Beginner loop code assistance needed

[Aleqs77]

New to VBA so please pardon my ignorance!
My data: i have a list of information relating to a number of managers and I want to send each manager their report without having to cut the excel file manually using filtering out unwanted managers and then saving a specific manager's report
What i want to achieve: I want to modify my code to allow me to loop and
a) run all the manager reports in one after another in one go using a defined list of managers in a the report producer tab
b) the loop should delete the unwanted managers based on the manager that we creating the report for
c) Save As - the report should be saved as that Manager's name

below is my current code and i am struggling with the areas marked as "----->". One is the manager's name, to help make it dynamic to follow the loop as it goes down the list from top to bottom
i.e. there are two tabs, Nominations Tracker tab with data and a Report Producer tab with my macros
For example:
Manager 1 - when loop is running their report, it should delete all other managers in Nominations tracker file field 68 and leave only this manager; save the report as manager 1, close it and proceed to create a report for Manager 2
Manager 2 - ditto
Manager 3 - ditto
etc

My macro ( a bad one.... but hey)

Sub cut_AllinOne()


Dim ws As Worksheet

Dim strName As String


' Select cell with *first line of Manager name

Sheets("Report producer").Select

Range("N11").Select

' Set Do loop to stop when an empty cell is reached.

Do Until IsEmpty(ActiveCell)


'Cut the first report

ActiveSheet.Calculate

Sheets("Nominations Tracker").Activate

Range("A6").Select

ActiveSheet.ShowAllData

-----> the next line is where you notice i have a fixed range at N11 but i want it to be dynamic as we loop to the next manager

On Error Resume Next

ActiveSheet.Range(Selection, Selection.End(xlDown)).AutoFilter Field:=68, Criteria1:="<>" & Sheets("Report producer").Range("N11"), Operator:=xlFilterValues

If Err.Number <> 0 Then

MsgBox "Requested filter does not exist.", _

vbExclamation, "No Such Filter"

End If

On Error GoTo 0

Range("a7").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.EntireRow.Delete

Range("c7").Select

On Error Resume Next

ActiveSheet.ShowAllData

On Error GoTo 0

Range("c7").Select

-----> also want to rename the tab dynamically as managers change

'SaveAs


strName = ThisWorkbook.Path & "\" & ActiveSheet.Name & " " & ".xlsx"

If strName = "False" Then Exit Sub 'User Canceled

ActiveWorkbook.SaveAs Filename:=strName


' Step down 1 row from present location.

ActiveCell.Offset(1, 0).Select

Loop

Sheets("Nominations Tracker").Select

Range("A1").Select


MsgBox "Check all the cuts have been made"



End Sub

 

[mse330]

Hi Aleqs77 & welcome to Mr. Excel

I have written the below code based off your code ... Give it a shot on a copy of you file to test it & let us know how it goes

Sub test()

Dim a, b, c, ws As Worksheet
a = Sheets("Report producer").Range("N11", Sheets("Report producer").Range("N" & Rows.Count).End(3))

With CreateObject("scripting.dictionary")
   For x = 1 To UBound(a)
      If Not .exists(a(x, 1)) Then .Add a(x, 1), Nothing
   Next
   a = .keys
End With

With Sheets("Nominations Tracker")
   If .AutoFilterMode Then .AutoFilterMode = False
   b = Filter(Evaluate(Replace("transpose(if(@<>"""",@))", "@", .Columns(68).Address)), False, False)
   For x = LBound(a) To UBound(a)
      c = Filter(b, a(x), True, 1)
      If UBound(c) > -1 Then
         Set ws = Workbooks.Add.Sheets(1)
         .Range("A6").CurrentRegion.AutoFilter 68, a(x), xlFilterValues
         .Range("A6").CurrentRegion.SpecialCells(12).Copy ws.Cells(1)
         ws.Parent.SaveAs ThisWorkbook.Path & "\" & a(x) & ".xlsx"
         ws.Parent.Close
      End If
   Next
   .AutoFilterMode = False
End With

MsgBox "Check all the cuts have been made", vbInformation

End Sub