Create tabs against main list, now I need errors

  • Thread starter Thread starter Neall
  • Start date Start date
N

Neall

Good day, I have created the following button that will search against my
list of customers and create a tab based on their customer number

Private Sub CreateSheetsFromAList()
Dim MyCell As Range, MyRange As Range

Set MyRange = Sheets("RawData").Range("RawData!L:L")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

For Each MyCell In MyRange
Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
Next MyCell
End Sub

Now I need to add 2 more options that I am not sure how to add.
1. add an error out option that if a tab already exists to skip creating
that tab and move on

2. I would like to get a summary in a box back of the name and customer
number that were just created in that update so I can go and take a look at
that customer.

Any suggestions?

Thanks in advance

Neall
 
I colored each cell in Myrange the color green. Then went through each sheet
and if the sheet name was in MyRange I removed the color. The cells that
were colored are the new customers. I then went back through each cell in
Myrange and the cells that were colored I added new sheets.

Private Sub CreateSheetsFromAList()
Dim MyCell As Range, MyRange As Range

Set MyRange = Sheets("RawData").Range("RawData!L:L")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

MyRange.Interior.ColorIndex = 4 'color every cell Green

'turn off the color if the sheet exists
For Each sht In Sheets
Set c = MyRange.Find(what:=sht.Name, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
c.Interior.ColorIndex = xlNone
End If
Next sht

'add new sheet for the items that are colored
For Each MyCell In MyRange
If MyCell.Interior.ColorIndex <> xlNone Then
Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
End If
Next MyCell
End Sub
 
Thanks, I am getting a application defined out of range error when trying to
move beyond this point

Set MyRange = Range(MyRange, MyRange.End(xlDown))

Any idea's?
 
You weren't specifying the sheet. I made a slight change. I didn't get the
error when I tested the code.

Private Sub CreateSheetsFromAList()
Dim MyCell As Range, MyRange As Range

With Sheets("RawData")
Set MyRange = .Range("L1")
Set MyRange = .Range(MyRange, MyRange.End(xlDown))
End With

MyRange.Interior.ColorIndex = 4 'color every cell Green

'turn off the color if the sheet exists
For Each sht In Sheets
Set c = MyRange.Find(what:=sht.Name, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
c.Interior.ColorIndex = xlNone
End If
Next sht

'add new sheet for the items that are colored
For Each MyCell In MyRange
If MyCell.Interior.ColorIndex <> xlNone Then
Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
End If
Next MyCell
End Sub
 
Back
Top