Macro stops running after creating new Workbook

Question

I have a work question and i want my macro to do the following

i have two columns (column A and B). Column A has the names and column B contains their info.

I want my macro to find duplicate names and copy both col A and B and paste them into another spreadsheet in the following location

C:\Users\kentan\Desktop\Managed Fund

Each spreadsheet created must contain the name of that name as the file name

I have create the macro to do the following but it's not giving me the right result

It's neither putting it into the managed fund folder (putting them instead on the desktop) AND its only copy pasting ONE ROW Into another spreadsheet

So my spreadsheet is like this

Investment Advisor  Managed Fund
Fidelity 1          Fidelity 20
Fidelity 1          Fidelity 21
PIMCO               PIMCO 22
PIMCO               PIMCO 23
PIMCO               PIMCO 24

what macro did was created a fidelity 1 spreadsheet and only put in

Fidelity 1  Fidelity 21 

instead of all the fidelity funds. Can you tell me why?

Option Explicit

Public Const strSA As String = "C:\Users\tempo\Desktop\Managed Fund "

Sub iris()
Dim i As Long
With ActiveSheet
    With .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 
1))
        .Sort key1:=.Columns(1), order1:=xlAscending, _
              key2:=.Columns(2), order2:=xlAscending, _
              Header:=xlYes, MatchCase:=False, _
              Orientation:=xlTopToBottom, SortMethod:=xlStroke
    End With

    For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).row
        If LCase(.Cells(i, "A").Value2) = LCase(.Cells(i - 1, "A").Value2) 
    And _
           LCase(.Cells(i, "A").Value2) <> LCase(.Cells(i + 1, "A").Value2) 
    Then
            newiris .Cells(i, "A").Value2, .Cells(i, "B").Value2
        End If
        Next
    End With
   End Sub

 Sub newiris(nm As String, nfo As String)
 Application.DisplayAlerts = False
With Workbooks.Add
    Do While .Worksheets.Count > 1: .Worksheets(2).Delete: Loop
    .Worksheets(1).Cells(1, "A").Resize(1, 2) = Array(nm, nfo)
    .SaveAs Filename:=strSA & nm, FileFormat:=xlOpenXMLWorkbook
    .Close savechanges:=False
End With
Application.DisplayAlerts = True
End Sub

Answer 1

Your problem is probably that Sub newiris() closes out the workbook. I don't fully understand the way macros are called but I know that often, once you close a workbook, code stops running.

Try creating the workbooks in one Sub, then closing them all at once. The code below may stop running after closing the first workbook, but at least you've created each workbook.

Option Explicit

Public Const strSA As String = "C:\Users\tempo\Desktop\Managed Fund "
Public newWorkbooks As Collection

Sub iris()
    Dim i As Long
    Dim nm As String
    Set newWorkbooks = New Collection

    With ActiveSheet
    With .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 1))
        .Sort key1:=.Columns(1), order1:=xlAscending, _
              key2:=.Columns(2), order2:=xlAscending, _
              Header:=xlYes, MatchCase:=False, _
              Orientation:=xlTopToBottom, SortMethod:=xlStroke
    End With

    For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
        nm = .Cells(i, "A").Value2
        If LCase(nm) = LCase(.Cells(i - 1, "A").Value2) _
        And _
           LCase(nm) <> LCase(.Cells(i + 1, "A").Value2) _
        Then
            newWorkbooks.Add ("Managed Fund " + nm + ".xlsx")
            newiris nm, .Cells(i, "B").Value2
        End If
        Next
    End With

    CloseWorkbooks

End Sub

Sub newiris(nm As String, nfo As String)
    Application.DisplayAlerts = False
    With Workbooks.Add
        Do While .Worksheets.Count > 1: .Worksheets(2).Delete: Loop
        .Worksheets(1).Cells(1, "A").Resize(1, 2) = Array(nm, nfo)
        .SaveAs Filename:=strSA & nm, FileFormat:=xlOpenXMLWorkbook
    End With
End Sub

Sub CloseWorkbooks()
    Dim i As Integer
    Dim wb As Workbook

    For i = 1 To (newWorkbooks.Count)

        Set wb = Workbooks(newWorkbooks(i))
        wb.Close savechanges:=False

    Next i
    Application.DisplayAlerts = True
End Sub