Beginner loop code assistance needed

Aleqs77

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

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).

mse330

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

Watch MrExcel Video

Forum statistics

Threads
1,122,630
Messages
5,597,264
Members
414,133
Latest member
lucid33

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 MrExcel.com.
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 "mrexcel.com".
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
Top