create new worksheet after cell (in a range) change

Question

I have cells A2 through A20 Would like to generate a new worksheet when cell values within that range change.

Additionally, the new worksheet generated would be renamed to the value of the changed cell.

I had this code working properly (for a single cell), until the range was requested by the user

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim ws As Worksheet
Dim lastrow As Long
lastrow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row + 1
Set KeyCells = Range("B5")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
       Is Nothing Then
For Each ws In Worksheets
With ActiveSheet
    If .Range("B5").Value <> "" Then .Name = .Range("B5").Value
End With
Cells(lastrow, "D").Value = Range("B5").Value
End If

End Sub

Shai Rado Shai Rado · Accepted Answer · 2016-12-29T13:37:56

The code below creates a new worksheet once a value inside Range("A2:A20") has changed, the new worksheet name equals the cell value.

The code also verifies that there is no exitsing sheet with that name (that will result with an error).

Code

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim KeyCells As Range
Dim ws As Worksheet
Dim lastrow As Long

' you are not doing anything currently with the last row
'lastrow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row + 1

' according to your post you are scanning Range A2:A20 (not B5)
Set KeyCells = Range("A2:A20")

If Not Intersect(KeyCells, Target) Is Nothing Then
    For Each ws In Worksheets
        ' if sheet with that name already exists
        If ws.Name = Target.Value Then
            MsgBox "A Worksheet with Cell " & Target.Value & " already exists"
            Exit Sub
        End If                  
    Next ws

    Set ws = Worksheets.Add
    ws.Name = Target.Value        
End If

End Sub

create new worksheet after cell (in a range) change

1 Answers