Adding Unique Sheets From Range Values - vba

Question

I am attempting to write code that runs through column G, and adds a new sheet for every unique value with out creating duplicates; However from what I have so so it creates duplicates
Public Sub AddSheet()
Worksheets("Dataset").Select
Range("A1", Range("A1").End(xlToRight)).Name = "Title"
Range("A2", Range("G1").End(xlDown)).Name = "Data"
Range("H2", Range("H1").End(xlDown)).Name = "Physician"
Dim i As Integer, lastrow As Integer
lastrow = Worksheets("Dataset").Cells(Worksheets("Dataset").Rows.Count, "H").End(xlUp).Row
With Range("Physician")
For i = 1 To lastrow
If i.Value = Worksheetexists = False Then
Sheet.Add
ActiveSheet.Name = Worksheets("Dataset").Cells(i, 1).Value
Else
GoTo NextStep:
End If
Next
End With
End Sub

Answer 1

something like this will iterate and create a new sheet for every unique value in Column A.
Public Sub AddSheet()
With Worksheets("Dataset")
Dim lastrow As Long
lastrow = .Cells(.Rows.Count, "H").End(xlUp).Row
Dim i As Long
For i = 1 To lastrow
If IsError(Application.Evaluate("'" & .Cells(i, 1).Value & "'!A1")) And .Cells(i, 1) <> "" Then
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets.Add
ws.Name = .Cells(i, 1).Value
End If
Next i
End With
End Sub

Answer 2

Something like this should work and be a bit safer as you may need to check the edge case that a sheet you are adding already exists. I'm using a dictionary to keep track of unique sheet names first, then adding to that based on the unique values in column H.
Sub SOExample()
Dim DataSheet As Excel.Worksheet
Dim ws As Excel.Worksheet
Dim lastRow As Long
Dim i As Long
Dim dict As Object
Dim SheetName As String
Set dict = CreateObject("Scripting.Dictionary")
Set DataSheet = ThisWorkbook.Worksheets("Dataset")
lastRow = DataSheet.Cells(DataSheet.Rows.Count, "H").End(xlUp).Row
'Add existing sheets into the dictionary first
'in case a sheet already exists with that name
For Each ws In ThisWorkbook.Worksheets
dict.Add ws.Name, ws.Name
Next
'Loop the range and add new sheets
For i = 1 To lastRow
SheetName = DataSheet.Cells(i, 8).Value 'Column H is index 8
If Not dict.exists(SheetName) Then
dict.Add SheetName, SheetName
Set ws = ThisWorkbook.Worksheets.Add
ws.Name = SheetName
End If
Next
End Sub