PDA

View Full Version : Check a list of names, if a worksheet exists move on, if not, create one



kmoyer
06-02-2014, 07:10 AM
My first post here. I am learning VBA and understand now why it is like learning a new language! I know there is a simple solution to what I want to do, but I am just learning and am stuck.

At my job, I have a current workbook that contains a worksheet titled "Names" which is a master list of all employees and then a worksheet for some of the employees in the list. Some of the employees don't have a worksheet, but I need to create one if that is the case. I would like to create a sub that looks at the list of names in the "Names" worksheet, skips the name if a worksheet exists for it and continues to check the list, and also creates a new worksheet if one doesn't exist for one of the names.


Sub createnamedworksheet ()
Dim ws As Worksheet
Dim NAMES As Range
Dim AllNames As Range
Dim WSName As String
Set AllNames = Sheets("AllNames").Range("NAMES", Range("NAMES").End(xlDown))
For Each NAMES In AllNames
wsName = NAMES.Value
If wsName <> "wsAllNames" Then
Sheets.Add
With ActiveSheet
.Move after:=Worksheets(Worksheets.Count)
.Name = wsName
End With
End If
Next NAMES
End Sub


This sub adds worksheets for the first few names, but as soon as it hits a name for which a worksheet already exists, it errors and tells me it can't add a worksheet
with a name that already exists.

The list of employee names on the Names worksheet can change as employees come and go. If a name is deleted from the list, I will need to figure out a sub to look at the worksheet tabs and delete any worksheets who don't have a corresponding name in the employees worksheet. I haven't even tried going there yet. It would save so much time to be able to automate this task, but I'm wasting so much time trying to figure it out. My boss is getting testy.

I looked around the forum but couldn't seem to find any posts that fit this situation, although some were close. Any advice would be appreciated.

mancubus
06-02-2014, 08:06 AM
welcome to the forum.

pls dont use reserved words (Application, Range, Name, Names, etc) to name variables. it's also good practice not to name named ranges, worksheets, etc with the reserved words.

assuming employee list starts at A2 and goes down to last non blank cell in column A, try this:



Sub CreateNamedWorksheet()

Dim ws As Worksheet
Dim cll As Range
Dim AllNames As Range

With Worksheets("AllNames")
Set AllNames = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
End With

On Error Resume Next
For Each cll In AllNames
If Len(cll.Value) > 0 Then
If Len(Worksheets(cll.Value).Name) = 0 Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = cll.Value
End If
End If
Next cll

End Sub

kmoyer
06-02-2014, 10:09 AM
Thank you so much, and thank you for the advice! It did "skip" the names for which worksheets exist and only added worksheets for the other names in the list. I am trying to understand the logic now, because I don't think I ever would have come up with this on my own. I get that If Len(cll.value) > 0 is looking for a value in the range of cells. I'm not sure what the Len(Worksheets(cll.Value).Name = 0 is saying ---- is it if the worksheet name doesn't exist for any cell in the range that has a name, then create it?

Now, I'm trying to write a sub to delete any worksheets in the workbook where the name may have been deleted from the AllNames worksheet. I've tried to use what I thought was the same logic you used but I can only get it to skip over and keep AllNames. It then proceeds to delete all the worksheets instead of just the one that no longer has a corresponding name in the list in the AllNames worksheet. Here is the code I used. Thank you so much for your advice!

With Worksheets("AllNames") Set AllNames = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
End With

For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "AllNames" Then
If Len(Worksheets(cll.Value).Name) <> Len(cll.Value) Then ws.Delete
End If



Next ws

mancubus
06-02-2014, 10:41 AM
you're welcome.

pls use code tags when pasting your code here.
the # button on the top right corner of the "quick reply" will do it for you.
click it, [ CODE ] [ /CODE ] tags (without extra spaces which i added to display them) will be inserted. paste your code between these tags.

that said, yes, the first condition tests if any cell in the ragce is blank. also it will be a good idea to trim the cell value in case cell contains nonprinting characters.

If Len(Trim(cll.Value)) > 0

and yes, the second condition tests the existence of a worksheet whose name is the cell value.

mancubus
06-02-2014, 10:45 AM
for deleting the worksheets, first test is OK.

but the second condition only compares the lengts of ws names to cell values.

kmoyer
06-02-2014, 11:12 AM
Thank you, again! I did not know why the other codes looked different. So, I get that I need to compare values. Still working on that. This didn't do it, but maybe I'm getting close.
Thank you.


For Each ws In ActiveWorkbook.Worksheets If ws.Name <> "AllNames" Then
If ws.Name <> cll.Value.Name Then ws.Delete
End If

mancubus
06-02-2014, 02:49 PM
you are welcome.

your homework is to analyze the below procedure... :)



Sub DelWSNotInTheList()

Dim ws As Worksheet
Dim i As Integer
Dim wsNames As Variant

ReDim wsNames(1 To Worksheets.Count)
With Worksheets("AllNames")
For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
If Len(Trim(.Range("A" & i))) > 0 Then
wsNames(i) = .Range("A" & i).Value
End If
Next i
End With

Application.DisplayAlerts = False

For Each ws In Worksheets
If ws.Name <> "AllNames" Then
If UBound(Filter(wsNames, ws.Name)) < 0 Then
ws.Delete
End If
End If
Next ws

Application.DisplayAlerts = True


End Sub

kmoyer
06-03-2014, 02:45 PM
Oh boy, that is a challenge! It might take me a day or so. Thanks! :)

mancubus
06-04-2014, 12:19 AM
just a fix for array index:



Sub DelWSNotInTheList()

Dim ws As Worksheet
Dim i As Integer
Dim wsNames As Variant

ReDim wsNames(1 To Worksheets.Count)

With Worksheets("AllNames")
For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
If Len(Trim(.Range("A" & i))) > 0 Then
wsNames(i - 1) = .Range("A" & i).Value
'"-1": i starts at 2 but lower bound of array wsNames is 1 and
'upper bound is total number of worksheets.
'(declared with ReDim wsNames(1 To Worksheets.Count) statement).
End If
Next i
End With

Application.DisplayAlerts = False

For Each ws In Worksheets
If ws.Name <> "AllNames" Then
If UBound(Filter(wsNames, ws.Name)) < 0 Then
ws.Delete
End If
End If
Next ws

Application.DisplayAlerts = True

End Sub