CODEWITHSUNDEEP
vbaexcel
bermudamohawk
bermudamohawk

Reputation: 17

create new worksheet after cell (in a range) change

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

Upvotes: 1

Views: 366

Answers (1)

Shai Rado
Shai Rado

Reputation: 33692

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

Upvotes: 2

Related Questions