Beginner loop code assistance needed


New Member
Jul 17, 2020
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

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


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

Do Until IsEmpty(ActiveCell)

'Cut the first report


Sheets("Nominations Tracker").Activate



-----> 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(Selection, Selection.End(xlDown)).Select



On Error Resume Next


On Error GoTo 0


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


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


Sheets("Nominations Tracker").Select


MsgBox "Check all the cuts have been made"

End Sub

Some videos you may like

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).


Well-known Member
Oct 18, 2007
Office Version
  1. 365
  1. Windows
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

VBA Code:
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
   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"
      End If
   .AutoFilterMode = False
End With

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

End Sub

Watch MrExcel Video

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back