How to put rest of uniques values in array if condition is not equal using vba excel

Question

I have two different uniques values( X, Y) which I have already done so far. I want to put the remaining uniques values in array if condition x<>y is not equal and need to create a workbook with array values(rest of uniques values).

Ex:

X               Y
SAP           Siemens
Siemens       otto
Otto          Allianz AG
Accenture     Oracle
Oracle        Capgemini
TCS           Daimler
Infosys       Akka

I already have workbook as "Siemens.xlsx", "Oracle.xlsx","Otto.xlsx". Now i need the rest of unique values of column Y in array. My expected result should be "Akka.xlsx", "Allainz AG. xlsx", "Daimler.xlsx".

Code:

Sub array()

    Dim y as range
    Dim c as integer
    Dim Lastrow_Y As Integer
    Dim Lastrow_X As Integer
    Dim rngFilter_Y as range
    Dim rngCopy as range
    Dim NewBook as workbook

    With Master_workbook.Worksheets("FBI")
            Sheets("FBI").Columns("C:C").AdvancedFilter Action:=xlFilterCopy, _
             CopyToRange:=.Range("AZ1"), Unique:=True
             Lastrow_Y = .Cells(.Rows.Count, "AY").End(xlUp).Row
   End with

   With Master_workbook.Worksheets("WWF")
            Sheets("WWF").Columns("d:d").AdvancedFilter Action:=xlFilterCopy, _
             CopyToRange:=.Range("AY1"), Unique:=True
             Lastrow_X = .Cells(.Rows.Count, "AY").End(xlUp).Row
   End with

    For c = 2 To Lastrow_Y
                    Set y = Master_workbook.Sheets("FBI").Range("AZ" & c)
                    Set x = Master_workbook.Sheets("WWF").Range("AY" & c) 
                        If x = y Then
                        set NewBook = workbooks.add
                            with NewBook 
                              .Title = y    NewBook.Worksheets.Add(After:=.Sheets(.Sheets.Count)).Name = "www"
                             With rngFilter_Y

                                    .AutoFilter field:=32, Criteria1:="<>(a)  0 - 360", Operator:=xlFilterValues
                                    .AutoFilter field:=37, Criteria1:=y.Value, Operator:=xlFilterValues

                                    Set rngCopy = .SpecialCells(xlCellTypeVisible)
                                                        .AutoFilter ' Switch off AutoFilter
                             End With
                        .SaveAs Filename:= Y & ".xlsx"

                         rngCopy.Copy NewBook.Worksheets("www").Cells(1, 1)

                        Else
                        End If
       Next    

    End sub

I would really appreciate if anyone help me out of this.

Answer 1

Seems to me like it'd be a lot easier to check the current folder for which files you have already created, then just create the ones in range Y that aren't already there?

Option Explicit

Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim folder : Set folder = fso.GetFolder(<path to your .xlsx files here>)
Dim file, fileNames, lastRowY, row, checkFile, newBook
For Each file in folder.Files
    If Right(file.Name, 4) = "xlsx" Then
        fileNames = fileNames & file.Name & ";"         ' will give a list of all filenames
    End If
Next

With Master_workbook.Worksheets("FBI")
       lastRowY = .Cells(.Rows.Count, "AY").End(xlUp).Row
End With

For row = 2 to lastRowY
    checkFile = Master_workbook.Worksheets("FBI").Range("AY").Value
    If Instr(fileNames, checkFile) = 0 Then
       Set newBook = Workbooks.Add
       ' do whatever with newBook
       newBook.SaveAs (checkFile & ".xlsx")
       newBook.Close
    End If
Next