#1
|
|||
|
|||
Insert Sheet via cell value
I want to use a code that allowed me to insert e new sheet
base on the value of the cell, or the content of the cell. Any help, pls? |
#2
|
|||
|
|||
If you want to add a worksheet and then give it the name of the active cell the code below will do that.
Code:
Sub CreateNamedWorksheet() Dim wb As Workbook, nws As Worksheet, NewName As String Dim ws As Worksheet, cws As Worksheet Set wb = ThisWorkbook Set cws = wb.ActiveSheet If ActiveCell.Value <> "" Then NewName = ActiveCell.Value For Each ws In wb.Worksheets If ws.Name = NewName Then MsgBox ("The name " & NewName & " is already in use. No new worksheet added.") End End If Next ws Set nws = wb.Worksheets.Add nws.Name = NewName Else MsgBox "The active cell has no value to name the new worksheet" End End If cws.Activate 'Use a ' right before this line to select the new worksheet. End Sub |
#3
|
|||
|
|||
Thank you for the answer,
But it didn't fulfill my need. I would like within a range cell any of data entered a new worksheet is entered into the workbook. Thx |
#4
|
|||
|
|||
Ok I partly understand. You want a code that looks at a range of cells. If any of these values are changed then you want a worksheet to be added?
If this is true a couple of things need to be identified. What is the maximum amount of worksheets you want possible in the workbook? What range do you want to check? Something like A2:A10? Do you want the new worksheet to be selected after if is created or stay on the orignal worksheet? Please post back the answers to these questions and I should be able to put something together. |
#5
|
|||
|
|||
That one is exactly what i want,
The maximum amount of the worksheet it will be 50 Range will be like D550 (And a version of code if the range is particular like ; D2540: D4560) I just want to continue in my current sheet (I don't want the new worksheet to be selected). In the range D550 I will set up data validation so when i put a value in the cell i want automatically the worksheet to be insert into the workbook. Thank you once more for helping me to fix that. Dritan |
#6
|
|||
|
|||
Ok not too bad. This code will check if the name already exists and will check if there are over 49 worksheets. Right now it has message boxes that come up if one of these stops occur. You can simply place a ' in front of any line of code to comment it out and cause Excel to ignore it.
You will need to paste this entire code into the actual worksheet object in the visual basic editor. Place it in the main worksheet that you will use. Let me know if you have any questions. Thanks Code:
Private Sub Worksheet_Change(ByVal Target As Range) Dim RangePass As Boolean If Target.Row > 4 And Target.Row < 51 Then If Target.Column = 4 And Target.Value <> "" Then CreateNewWorksheet (Target.Value) End If End Sub Sub CreateNewWorksheet(UseValue As String) Dim wb As Workbook, nws As Worksheet, NewName As String Dim ws As Worksheet, cws As Worksheet Set wb = ThisWorkbook Set cws = wb.ActiveSheet NewName = UseValue If wb.Worksheets.Count > 49 Then MsgBox "This workbook can only contain 50 worksheets." 'If you dont want the messagebox to come up just comment it out with a ' End End If For Each ws In wb.Worksheets If ws.Name = NewName Then MsgBox ("The name " & NewName & " is already in use. No new worksheet added.") 'You can comment out the message box if you just want code to end. End End If Next ws 'All passed add the new worksheet Set nws = wb.Worksheets.Add nws.Name = NewName cws.Activate 'Use a ' right before this line to select the new worksheet. End Sub |
#7
|
|||
|
|||
One other thing while it is on my mind. In the event that you do have over 49 worksheets. simply deleting a value will not remove that worksheet. We would need to write a few more lines of code for that. Let me know if that is needed or not. If it is I will need to know what worksheets in the workbook to not delete since I would write a loop to check all the values in D5 to D50 checking if there is a worksheet with the name or not. If there is a workbook name not in that list it would delete the worksheet. This can bring lots of problems though since when you delete a worksheet you cannot get the data back We could always write a backup program to pull all the data off that worksheet and store it in a temporary location incase in does get deleted. Hopefully we do not need to go that route since it will be a lot of work.
Let me know. |
#8
|
|||
|
|||
Hi,
It will be perfect if you write a code like that(if the value in the cell is deleted the new worksheet will be deleted automatically), because it will make the workbook dynamic. I can protect then the cells via password protected so the information will be safe. thanks a lot for you help, I really appreciate |
#9
|
|||
|
|||
Ok I can do this but like I mentioned before I need to know what worksheets to ignore. The reason is because The code will look through every worksheet name and if that name is not in the D5 to D50 list it will get deleted. Now if the only worksheet left to spare is the worksheet where you enter data into d5 to d50 then that's really easy however If it is not then you will run into a problem.
Let me know which worksheet names to spare (Data validation will not keep them from getting deleted.) or if I just need to spare the main worksheet. Thanks |
#10
|
|||
|
|||
hi,
Yes the worksheet which das data (D550) need to be ignore (or a static sheet), the rest of the sheet can be dynamic. Thank you |
#11
|
|||
|
|||
Ok here we go. I put in some additional checks since worksheet names can not be over 31 characters or contain certain special characters. Please ensure that you 100% back up your work on all open excel workbooks when running this. It will delete all worksheets that are not in the range and it will not give a prompt before doing this.
Same instructions as above. Let me know if you have any questions. Code:
Private Sub Worksheet_Change(ByVal Target As Range) Dim RangePass As Boolean If Target.Count > 1 Then CreateNewWorksheet ("") Exit Sub End If If Target.Row > 4 And Target.Row < 51 Then If Target.Column = 4 And Target.Value <> "" Then CreateNewWorksheet (Target.Value) End If End Sub Sub CreateNewWorksheet(UseValue As String) Dim wb As Workbook, nws As Worksheet, NewName As String Dim ws As Worksheet, cws As Worksheet, CheckString As String Dim CheckRow As Integer, CheckName As String, BadData As Variant Dim TempString As String, v As Variant Set wb = ThisWorkbook Set cws = wb.ActiveSheet BadData = Array("*", "[", "]", "/", "\", "?", "'", ":") 'Add range names to a string to check CheckString = "" For CheckRow = 5 To 50 TempString = Range("D" & CheckRow).Value For Each v In BadData TempString = Replace(TempString, v, "") Next v CheckString = CheckString & "[" & TempString & "]" Next CheckRow CheckString = "[" & cws.Name & "]" & CheckString 'Delete not found worksheets For Each ws In wb.Worksheets CheckName = "[" & ws.Name & "]" Application.DisplayAlerts = False If InStr(1, CheckString, CheckName) = 0 Then ws.Delete End If Next ws Application.DisplayAlerts = True NewName = UseValue 'Clear special characters For Each v In BadData NewName = Replace(NewName, v, "") Next v If NewName = "" Then End If Len(NewName) > 31 Then MsgBox "Name too long. no worksheet added." End End If If wb.Worksheets.Count > 49 Then MsgBox "This workbook can only contain 50 worksheets." 'If you dont want the messagebox to come up just comment it out with a ' End End If For Each ws In wb.Worksheets If ws.Name = NewName Then MsgBox ("The name " & NewName & " is already in use. No new worksheet added.") 'You can comment out the message box if you just want code to end. End End If Next ws 'All passed add the new worksheet Set nws = wb.Worksheets.Add(After:=cws) nws.Name = NewName cws.Activate 'Use a ' right before this line to select the new worksheet. End Sub |
#12
|
|||
|
|||
Hi,
You have done great job , super super Now I'll go through and start to understand. One quick question: Does this code work with any excel/VBA version? If I have other question may i come back to you again? Thank you so much for your help Dritan |
#13
|
|||
|
|||
Thank you so much for the kind words. The code should work for most Excel versions. I have seen issues with some code running on Macs though. You are more than welcome to reach out to me with any questions.
|
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Help Coloring a cell in Sheet one if data is missing from another sheet | Aeducan | Excel | 1 | 06-22-2014 04:49 PM |
How to set a hyperlink from a pp presentation into a CELL from an excel sheet | Sabi | PowerPoint | 1 | 04-30-2013 06:36 AM |
Insert Excel sheet | markg2 | Word | 1 | 12-15-2010 12:19 PM |
copy cell from sheet 2 to sheet 3 macro | slipperyjim | Excel Programming | 1 | 02-18-2010 01:31 AM |