VBA to generate new sheet

[twl2009]

Hi, I need a bit of code that when any text is entered into range A11:G23 if that specific text isnt matched in the range anywhere it creates a new sheet (a copy of sheet2) and names it with the text entered.

Is this possible?

Thanks

 

[Joe4]

Right-click on the sheet tab name at the bottom of your sheet, select View Code, and paste this code in the resulting VBA Window.
It should do what you want:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim myRange As Range
    Dim isect As Range

'   If more than one cell updated at once, exit sub
    If Target.Count > 1 Then Exit Sub
    
'   Check to see if update made in range A11:G23
    Set myRange = Range("A11:G23")
    Set isect = Intersect(Target, myRange)
    If isect Is Nothing Then Exit Sub
    
'   Count to see how many cells in range match entry
    If Application.WorksheetFunction.CountIf(myRange, Target) = 1 Then
        Cells.Copy
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Paste
        Application.CutCopyMode = False
        ActiveSheet.Name = Target.Value
    End If
    
End Sub

 

[JLGWhiz]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim newSh As Worksheet
If Target.Cells.Count > 1 Or Target = "" Then Exit Sub
If Application.CountIf(Range("A11:G23"), Target.Value) = 1 Then
    Set newSh = Sheets.Add
    newSh.Name = Target.Value
End If
End Sub

Copy code to worksheet code module of the sheet with source data.

 

[Joe4]

JLGWhiz,

I see one potential problem with your code.

I need a bit of code that when any text is entered into range A11:G23 if that specific text isnt matched in the range anywhere it creates a new sheet (a copy of sheet2) and names it with the text entered.

They way that the code is written, they could enter something outside of range A11:G23, and if it matches exactly one item with range A11:A23, then it will create a new sheet.
You code probably needs to be amended to make sure that the cell being updated (Target) resides in the range A11:G23 (which is why I used Intersect).

 

[twl2009]

Thanks Joe that works nicely, except it copies the sheet im on rather than sheet 2, which is 'Timesheet'
Also it would be great to stay on the sheet im working on rather than go to the new sheet.

 

[Joe4]

I thought you were on Sheet2 when running the code. Didn't realize that you were on a different sheet (not quite clear from the original question).
Just need to add one simple line:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim myRange As Range
    Dim isect As Range

'   If more than one cell updated at once, exit sub
    If Target.Count > 1 Then Exit Sub
    
'   Check to see if update made in range A11:G23
    Set myRange = Range("A11:G23")
    Set isect = Intersect(Target, myRange)
    If isect Is Nothing Then Exit Sub
    
'   Count to see how many cells in range match entry
    If Application.WorksheetFunction.CountIf(myRange, Target) = 1 Then
[COLOR=#ff0000]        Sheets("Sheet2").Activate[/COLOR]
        Cells.Copy
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Paste
        Application.CutCopyMode = False
        ActiveSheet.Name = Target.Value
    End If
    
End Sub

 

[JLGWhiz]

JLGWhiz,

I see one potential problem with your code.

They way that the code is written, they could enter something outside of range A11:G23, and if it matches exactly one item with range A11:A23, then it will create a new sheet.
You code probably needs to be amended to make sure that the cell being updated (Target) resides in the range A11:G23 (which is why I used Intersect).

Yep, you're right, Joe4. Senility strikes again!
regards, JLG

 

[Joe4]

Yep, you're right, Joe4. Senility strikes again!

We can't beat Mother Nature. She always wins in the end.
I have had perfect vision all my life, and am now starting to have issues reading small things.
I fear it is only the beginning!

 

[twl2009]

Thanks Joe. I ended up with this.

But I realise now that I will need the new sheet to be deleted if the specific text is deleted and doesn't appear anywhere else in the range. I imagine this is not so easy.


<style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #000000; background-color: #ffffff}p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; background-color: #ffffff; min-height: 13.0px}p.p3 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #011993; background-color: #ffffff}p.p4 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #000000; background-color: #ffffff; min-height: 13.0px}span.s1 {color: #011993}span.s2 {color: #000000}</style>Private Sub Worksheet_Change(ByVal Target As Range)


Application.ScreenUpdating = False


Dim myRange As Range
Dim isect As Range


If Target.Count > 1 Then Exit Sub


Set myRange = Range("A11:G23")
Set isect = Intersect(Target, myRange)
If isect Is Nothing Then Exit Sub

If Application.WorksheetFunction.CountIf(myRange, Target) = 1 Then
Sheets("Timesheet").Cells.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Name = Target.Value & " Timesheet"
End If

Application.Goto Worksheets("Weekly Labour").Range("A5")


Application.ScreenUpdating = True

End Sub

 

[Joe4]

But I realise now that I will need the new sheet to be deleted if the specific text is deleted and doesn't appear anywhere else in the range. I imagine this is not so easy.

Trying to capture text that is no longer there is a bit tricky (see: How do I get the old value of a changed cell in Excel VBA? - Stack Overflow). I prefer to do it another way.
Don't let them enter anything to the sheet directly. Have a form or button that they can click if they want to add or delete something, and then you can use that VBA code to capture it, and do whatever needs to be done.