Excel VBA Question

I am trying to write a sub that does the following: (1) for each city in the list, it checks whether there is a sheet with there is a sheet with the name of that city in the workbook, and if there isn't one, it adds one, and (2) it deletes any city sheet if the sheet's name is not in the current AllCities list.  The sub should be written so that it can be run at any time and will always respond with the current list of cities in the AllCities sheet.  (note: the sub should work if the AllCities list has exactly one city or if it has no cities.)   I also attach the excel template.
Company-Locations.xlsx
MasterOfTheSkyAsked:
Who is Participating?
 
TracyConnect With a Mentor VBA DeveloperCommented:
Try this:
Sub CheckCities()

    Dim i As Long
    Dim lastRow As Long
    Dim myCity As String
    Dim wksht As Worksheet
    Dim myCount As Integer
    Dim blnFound As Boolean
    
    Sheets("AllCities").Activate
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    myCount = 0
    
    Dim shtNames() As String 'Allow for dynamically sized array
    'Dim shtNames(9) As String 'Set size of array to static number
    
    'Add Sheets
    For i = 2 To lastRow
        Sheets("AllCities").Activate
        myCity = Trim(Cells(i, 1).Value)
        ReDim Preserve shtNames(myCount) 'Increase the size of the array, but preserve existing elements
        shtNames(myCount) = myCity 'Set new value to array
        myCount = myCount + 1
        'Add Sheets
        If Not WorksheetExists(myCity) Then
            Sheets.Add , Sheets(1)
            ActiveSheet.Name = myCity
        Else
        End If
    Next i
    
    If lastRow = 1 Then 'No Names in list
        For Each wksht In ThisWorkbook.Sheets
             If wksht.Name <> "AllCities" Then
                Application.DisplayAlerts = False
                wksht.Delete
                Application.DisplayAlerts = True
            Else
            End If
        Next
    Else
        'Remove any Sheets that don't exist in AllCities sheet list
        blnFound = False
        For Each wksht In ThisWorkbook.Sheets
            If wksht.Name <> "AllCities" Then
                For myCount = LBound(shtNames) To UBound(shtNames)
                    If wksht.Name = shtNames(myCount) Then
                        blnFound = True
                        GoTo skip
                    Else
                    End If
                Next
skip:
                If blnFound = False Then
                    Application.DisplayAlerts = False
                    wksht.Delete
                    Application.DisplayAlerts = True
                    blnFound = True
                Else
                End If
            Else
            End If
            blnFound = False
        Next
    End If
    
End Sub

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean

    On Error Resume Next
    WorksheetExists = (Sheets(WorksheetName).Name <> "")
    On Error GoTo 0

End Function

Open in new window

Company-Locations.xls
0
 
MasterOfTheSkyAuthor Commented:
Great Job!! Sorry for taking so long to reply to you.  
0
All Courses

From novice to tech pro — start learning today.