VBA Code fails on selecting the name to save the file

Hello,

I have a file that looks like this.

https://preview.redd.it/torubjc8erxb1.png?width=583&format=png&auto=webp&s=ad0e831c2291753a12079be9d93226a67c126a48

I have a VBA (see below) that based on the "EngagementFirmName" creates a separate file for each firm.

The problem is that it doesn't assign the proper name to the file. For example,

• Iteration 1
  • Code copies all line items related to "Anguilla"
  • Code pastes the line items (including the header) in a new file
  • Code saves the file using the "Antigua and Barbuda" as name
• Iteration 2
  • Code copies all line items related to "Antigua and Barbuda"
  • Code pastes the line items (including the header) in a new file
  • Code saves the file using the "Australia" as name
• And so on

I can't understand why, can you please help?

Sub SplitByOrganisation()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim orgCol As Range
    Dim orgName As String
    Dim orgRange As Range
    Dim orgCell As Range
    Dim i As Long
    Dim newWb As Workbook
    Dim newRow As Long
    Dim savePath As String
    
    ' Define the path where you want to save the new files
    savePath = "C:\Users\AEterni\OneDrive - BDO O365 World\Desktop\APT CLEAN UP\APTNG\" ' Change to the desired directory
    
    ' Ensure the path exists
    If Dir(savePath, vbDirectory) = "" Then
        MkDir savePath
    End If
    
    ' Define the worksheet where your data is located
    Set ws = ThisWorkbook.Worksheets("APTNGCleanUpReport") ' Change "Sheet1" to your sheet name
    
    ' Define the column with organization names (change the column letter if needed)
    Set orgCol = ws.Range("D:D") ' Change "A" to the appropriate column
    
    lastRow = ws.Cells(ws.Rows.Count, orgCol.Column).End(xlUp).Row
    newRow = 2 ' Initialize the new row in the new workbook
    
    ' Loop through the data
    For i = 2 To lastRow ' Assuming your data starts from the second row
        orgName = orgCol.Cells(i, 1).Value
        ' Check if the organization name has changed
        If orgName <> orgCol.Cells(i - 1, 1).Value Then
            ' Save the previous workbook with the correct organization name and close it
            If Not newWb Is Nothing Then
                newWb.SaveAs savePath & orgName & ".xlsx"
                newWb.Close False ' Close the workbook without saving changes
            End If
            ' Create a new workbook for the organization
            Set newWb = Workbooks.Add
            ' Copy the header row to the new workbook
            ws.Rows(1).Copy newWb.Sheets(1).Rows(1)
            newRow = 2 ' Reset the new row for the new workbook
        End If
        ' Copy the data to the respective organization sheet in the new workbook
        Set orgRange = newWb.Sheets(1).Cells(newRow, 1)
        Set orgCell = ws.Cells(i, 1)
        orgCell.EntireRow.Copy orgRange
        newRow = newRow + 1 ' Increment the new row for the new workbook
    Next i
    ' Save the last workbook with the correct organization name and close it
    If Not newWb Is Nothing Then
        newWb.SaveAs savePath & orgName & ".xlsx"
        newWb.Close False ' Close the workbook without saving changes
    End If
End Sub

​