Excel issue with automatic created worksheets

Question

HI I have created a VBA that takes info from a ALL data sheet and plots it in worksheets. The worksheets get automatically generated which is great but the issue is that VBA is only supposed to create Unique worksheets - however this is not the case. Example: if in my ALL data sheet I have IKEA 3 times then the first time the vba encounters IKEA then it should create a worksheet while it should ignore any repeats.

Actual

IKEA; Sheet 2 ; Sheet 3

Wanted

IKEA

VBA Code

Sub CreateSheetsFromAList()
   Dim iReply As Integer
   Dim MyCell As Range, MyRange As Range

   On Error Resume Next

   Range("B1").End(xlUp).AdvancedFilter _
       Action:=xlFilterCopy, CopyToRange:=rListPaste.Cells(1, 1), Unique:=True

   Set MyRange = Sheets("ALL").Range("B1")
   Set MyRange = Range(MyRange, MyRange.End(xlDown))

   For Each MyCell In MyRange
       Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
       Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
   Next MyCell
End Sub

Answer 1

Try this code (it creates new sheet only if there is no sheets with name MyCell.Value):

Sub CreateSheetsFromAList()

  Dim iReply As Integer
  Dim MyCell As Range, MyRange As Range
  Dim sh as Worksheet

  On Error Resume Next

  Range("B1").End(xlUp).AdvancedFilter _
      Action:=xlFilterCopy, CopyToRange:=rListPaste.Cells(1, 1), Unique:=True

  Set MyRange = Sheets("ALL").Range("B1")
  Set MyRange = Range(MyRange, MyRange.End(xlDown))

  For Each MyCell In MyRange
      Set sh = Nothing
      Set sh=Sheets(MyCell.Value)
      If sh is Nothing Then
          Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet  
          Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
      End If        
  Next MyCell
End Sub