Why am I getting else without if error when trying to add extra part to previously working code?

I need to create a workbook for each unique department code in a column on a master workbook sheet ('LastYear') and populate sheet 1 of each new workbook with the relevant information for each department from last year. If found some code on here that allows me to do that and it worked great.

I also need to perform a very similar process for articles in the same department for a second tab in the master workbook ('ThisYear') with a different number of lines and columns to last year's data. So rather than create a new workbook for each department, I need to populate worksheet 2 of each workbook where the department matches the one on worksheet 1.

I've tried to insert this into the code but I'm getting an 'Else without If' error, but I'm sure I've closed each if appropriately, and ensured that all code after each 'Then' is on a new line.

Apologies if I'm missing something obvious, I've been looking so long I can't see the wood for the trees!

Thanks in advance

I've searched on here and other sites for possible causes/solutions but none of the answers are quite applicable.

             '''''THE BIT I FOUND ON HERE THAT WORKS'''''
Option Explicit

Sub SplitbyDept()
Dim unique(10000) As String, uniqueB(10000) As String
Dim wbNew(10000) As Workbook, Master As Workbook
Dim LastYr As Worksheet, ThisYr As Worksheet, Upload As Worksheet, MainPg As Worksheet
Dim x As Long, y As Long, ct As Long, uCol As Long, xb As Long, yb As Long, ctb As Long, uColb As Long

On Error GoTo ErrHandler

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'Source
Set Master = ActiveWorkbook
Set LastYr = Master.Sheets("LastYear")
Set ThisYr = Master.Sheets("ThisYear")

'Unique dept column
uCol = 10

ct = 0

'get a list of unique departments
For x = 2 To LastYr.Cells(LastYr.Rows.Count, uCol).End(xlUp).Row
    If CountIfArray(LastYr.Cells(x, uCol), unique()) = 0 Then
        unique(ct) = LastYr.Cells(x, uCol).Text
        ct = ct + 1
    End If
Next x

'loop through unique
For x = 0 To LastYr.Cells(LastYr.Rows.Count, uCol).End(xlUp).Row - 1

    If unique(x) <> "" Then
        'add workbook
        Set wbNew(x) = Workbooks.Add

        'copy header row
        LastYr.Range(LastYr.Cells(1, 1), LastYr.Cells(1, uCol)).Copy wbNew(x).Sheets(1).Cells(1, 1)

        'loop to find matching departments in LastYr and copy over
        For y = 2 To LastYr.Cells(LastYr.Rows.Count, uCol).End(xlUp).Row
            If LastYr.Cells(y, uCol) = unique(x) Then

               'to copy and paste values
                LastYr.Range(LastYr.Cells(y, 1), LastYr.Cells(y, uCol)).Copy
                wbNew(x).Sheets(1).Cells(WorksheetFunction.CountA(wbNew(x).Sheets(1).Columns(uCol)) + 1, 1).PasteSpecial (xlPasteValues)

            End If
        Next y

           ''''''PART I'M TRYING TO ADD''''''

        'This year unique column
        uColb = ThisYr.Columns(16)

        ctb = 0

        'get a list of unique departments
        For xb = 2 To ThisYr.Cells(ThisYr.Rows.Count, uColb).End(xlUp).Row
            If CountIfArrayb(ThisYr.Cells(xb, uColb), uniqueB()) = 0 Then
                uniqueB(ctb) = ThisYr.Cells(xb, uColb).Text
                ctb = ctb + 1
            End If
        Next xb

        'loop through unique in this year's data
        For xb = 0 To ThisYr.Cells(ThisYr.Rows.Count, uColb).End(xlUp).Row - 1

            If unique(xb) <> "" Then
                'assign worksheet
                Set Upload(xb) = wbNew(x).Sheets(2)

                'copy header row
                ThisYr.Range(ThisYr.Cells(1, 1), ThisYr.Cells(1, uColb)).Copy wbNew(x).Sheets(2).Cells(1, 1)

                'loop to find matching departments in ThisYr and copy over
                For yb = 2 To ThisYr.Cells(ThisYr.Rows.Count, uColb).End(xlUp).Row
                    If ThisYr.Cells(y, uColb) = uniqueB(xb) Then

                       'to copy and paste values
                        ThisYr.Range(ThisYr.Cells(yb, 1), ThisYr.Cells(yb, uColb)).Copy
                        wbNew(x).Sheets(2).Cells(WorksheetFunction.CountA(wbNew(x).Sheets(2).Columns(uColb)) + 1, 1).PasteSpecial (xlPasteValues)

                    End If
                Next yb
            Else

                Exit For

            End If


        'autofit and name
        wbNew(x).Sheets(1).Columns.AutoFit
        wbNew(x).Sheets(2).Columns.AutoFit
        wbNew(x).Sheets(3).Columns.AutoFit
        wbNew(x).Sheets(1).Name = "LastYear_" & unique(x)
        wbNew(x).Sheets(2).Name = "Upload_" & unique(x)
        wbNew(x).Sheets(3).Name = "Merchandiser_Updates"

             '''''END OF PART I'M TRYING TO ADD'''''

        'save when done
        wbNew(x).SaveAs ThisWorkbook.Path & "\" & "categorisation" & unique(x) & " " & Format(Now(), "mm-dd-yy")
        'wbNew(x).Close SaveChanges:=True

    Else '<<<<<<<<<<<<<<<<<<<<<<<<<<<------------------The error is here
    'once reaching blank parts of the array, quit loop
        Exit For
    End If

Next x

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Public Function CountIfArray(lookup_value As String, lookup_array As Variant)
CountIfArray = Application.Count(Application.Match(lookup_value, lookup_array, 0))
End Function

Public Function CountIfArrayb(lookup_valueb As String, lookup_arrayb As Variant)
CountIfArrayb = Application.Count(Application.Match(lookup_valueb, lookup_arrayb, 0))
End Function