adding , deleting worksheets etc

Hi,
I have question for a specific file that attached here. I need to write a sub that
1- for each city in the list, it should check whether there is a seperate sheet for that city, if not it adds one
2- it deletes any city sheet if the name is not in the Allcities sheet

Thanks for any help.
Cities.xlsx
learningmacroAsked:
Who is Participating?
 
nicsaintConnect With a Mentor Commented:
This adds the listed city sheets and confirms deletion of a missing highlighted sheet before actually deleting it

Dim city_item
Dim sheet_item
Dim i
Sheets("AllCities").Select
    For Each city_item In Range("A3", Range("A3").End(xlDown).Address)
        If Len(city_item.Value) > 0 Then
            i = 0
            For Each sheet_item In Sheets
                If city_item.Value = sheet_item.Name Then
                    i = i + 1
                End If
            Next
            If i = 0 Then
                Sheets.Add After:=Sheets(Sheets.Count)
                Sheets(Sheets.Count).Name = city_item
            End If
        End If
    Next
    Sheets("AllCities").Select
    For Each sheet_item In Sheets
        i = 0
        For Each city_item In Range("A3", Range("A3").End(xlDown).Address)
            If city_item.Value = sheet_item.Name Then
                i = i + 1
            End If
        Next
        If i = 0 And sheet_item.Name <> "AllCities" Then
            Sheets(sheet_item.Name).Select
            Sheets(sheet_item.Name).Delete
        End If
        Sheets("AllCities").Select
    Next
0
 
Saqib Husain, SyedEngineerCommented:
Try this code

Sub adshtnewcity()
Set acsht = ActiveSheet
For Each cel In Range("A3", Range("A3").End(xlDown).Address)
    exst = False
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name = cel Then exst = True: Exit For
    Next ws
    If exst = False Then
        ActiveWorkbook.Worksheets.Add
        ActiveSheet.Name = cel
        acsht.Activate
    End If
Next cel
End Sub
0
 
Saqib Husain, SyedEngineerCommented:
Try this macro with the Allcities tab active

For Each cel In Range("A3", Range("A3").End(xlDown).Address)
    exst = False
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name = cel Then exst = True: Exit For
    Next ws
    If exst = False Then
        ActiveWorkbook.Worksheets.Add
        ActiveSheet.Name = cel
        acsht.Activate
    End If
Next cel
temp = Application.DisplayAlerts
Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "AllCities" Then
exst = False
    For Each cel In Range("A3", Range("A3").End(xlDown).Address)
        If ws.Name = cel Then exst = True: Exit For
    Next cel
    If exst = False Then
        ws.Delete
    End If
End If
Next ws
Application.DisplayAlerts = temp
End Sub
0
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
Saqib Husain, SyedEngineerCommented:
This one does not ask for confirmation before deleting
0
 
JeewsCommented:
Check This
Sub SyncSheets()

Dim llSheetFound As Boolean, llSheetNameFound As Boolean

lcSheetName = False

      
For Each LoRow In ThisWorkbook.Worksheets(1).Rows

    If LoRow.Row > 1 Then

        If Len(Trim(LoRow.Cells(1, 1).Value)) > 0 Then
        
            lcSheetName = LoRow.Cells(1, 1).Value
            
            
            For Each losheet In ThisWorkbook.Worksheets
                If UCase(Trim(losheet.Name)) = UCase(Trim(lcSheetName)) Then
                    llSheetFound = True
                End If
            Next
            
            
            If Not llSheetFound Then
                Sheets(ThisWorkbook.Worksheets.Count).Select
                Sheets.Add
                ThisWorkbook.ActiveSheet.Name = lcSheetName
            End If
        Else
            Exit For
        End If
    End If
Next

Set losheet = Nothing

For Each losheet In ThisWorkbook.Worksheets
    
    lcSheetName = losheet.Name
    
    For Each loCell In ThisWorkbook.Worksheets(1).Columns(1).Rows
        If loCell.Row > 1 Then
            If Len(Trim(loCell.Value)) > 0 Then
                If UCase(Trim(loCell.Value)) = UCase(Trim(lcSheetName)) Then
                    llSheetNameFound = True
                End If
            Else
                Exit For
            End If
        End If
    Next
    
    If Not llSheetNameFound Then
        If Not UCase(Trim(losheet.Name)) = "ALLCITIES" Then
            Application.DisplayAlerts = False
            ThisWorkbook.Worksheets(losheet.Index).Delete
            Application.DisplayAlerts = True
        End If
    End If
    
Next

Open in new window

0
 
luconstaCommented:
And other ideea splitted in 2 parts - one for adding sheets and the other for deleting them (without confirmation).
One requirement - use a "Named range" = Cities for the cities list for easier VBA coding:


Sub SyncCities()
    CheckSheet4City
    CheckSheetinCity
End Sub
Sub CheckSheet4City()
    Dim cWSName As String
    For Each Cell In Range("Cities")
        cWSName = Cell.Value
        If WSExist(cWSName) = False Then
            Sheets.Add.Name = cWSName
        End If
    Next Cell
End Sub

Sub CheckSheetinCity()
    Dim oWS As Worksheet
    Dim cWSName As String
    Dim lFound As Boolean
    For Each oWS In Worksheets
        cWSName = oWS.Name
        If cWSName <> "AllCities" Then          'Protect AllCities Sheet
            lFound = False
            For Each Cell In Range("Cities")
                If cWSName = Cell.Value Then
                    lFound = True
                End If
            Next Cell
            
            If lFound = False Then
                Application.DisplayAlerts = False
                Sheets(cWSName).Delete
                Application.DisplayAlerts = True
            End If
        End If
    Next oWS

End Sub
Function WSExist(cWSName) As Boolean
    Dim wsSheet As Worksheet
    Dim cResult As Boolean
    On Error Resume Next
    Set wsSheet = Sheets(cWSName)
    On Error GoTo 0
    If Not wsSheet Is Nothing Then
        cResult = True
    Else
        cResult = False
    End If
    WSExist = cResult
End Function

Open in new window

0
 
luconstaCommented:
Sorry - forgot to mention that tha main sub is the first one - SyncCities.
0
 
nicsaintCommented:
To sort the sheets in alphabetical order after the code has run insert the following at the end of my script above, or any of the above scripts for that matter if you so wish.

For i = 1 To Sheets.Count
      For sortsheet = 1 To Sheets.Count - 1
            If Sheets(sortsheet).Name > Sheets(sortsheet + 1).Name Then
               Sheets(sortsheet).Move After:=Sheets(sortsheet + 1)
            End If
      Next sortsheet
 Next i
0
All Courses

From novice to tech pro — start learning today.