Auto Create New Tabs

[ben4]

I have a column with multiple currencies. Is there a way to write a formula or some code that will look to that column, and create a new Tab for each new currency name it finds, and then name the Tab that currency?

For example, C5:C15 has an assortment of entries either USD, GBP, AUD. I'd like a search that looks to C5 and creates a new tab labeled whatever the first currency is, then move down the column and do the same thing every time it encounters a new currency, but pass over a cell if it's a currency that already has a tab made for it.

Just wondering if this is possible. Would make my process so slick if it could be done!! Thanks!
Ben

 

[dafan]

Try this:

Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim c As Range
Dim strCur As String
exists = 0
    For Each c In Sheet1.Range("C5:C15")
        strCur = c.Value
        exists = 0
        For Each ws In Worksheets
            If ws.Name = strCur Then
                exists = 1
            End If
        Next
 
        If exists = 0 Then
            Worksheets.Add
            ActiveSheet.Name = strCur
        End If
    Next
 
 
 
End Sub

Change Sheet1.Range("C5:C15") as necessary.

 

[ben4]

dafan, this looks cool. Thanks for your help!

Is there a way to skip a blank cell in my array though? The way my initial table is set up, I have blank rows between accounts, and this code is error-ing out whenever it hits a blank cell.

Thanks,
Ben

 

[vaendryl]

you could test with a

if c.value="" then exit for

or something. just put it right below the for each c line

 

[ben4]

That keeps me from erroring, but I'd like it to continue on to the next cell until it gets to the bottom of the array. Is there another "key word" i can sub in there instead of "exit"? Such as "next" or "next for" or "skip"?? Just throwing out ideas...

 

[vaendryl]

That keeps me from erroring, but I'd like it to continue on to the next cell until it gets to the bottom of the array. Is there another "key word" i can sub in there instead of "exit"? Such as "next" or "next for" or "skip"?? Just throwing out ideas...

ah yes of course. my bad. this should work :

Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim c As Range
Dim strCur As String
exists = 0
    For Each c In Sheet1.Range("C5:C15")
        If Not c.Value = "" Then
           strCur = c.Value
           exists = 0
           For Each ws In Worksheets
               If ws.Name = strCur Then
                   exists = 1
               End If
           Next
           If exists = 0 Then
               Worksheets.Add
               ActiveSheet.Name = strCur
           End If
        End If
    Next
End Sub

basically it tests for an empty cell first, and only if it doesn't find one it does the other stuff.

 

[ben4]

vaendryl - works like a charm! Thanks so much.

any help now on going back to Sheet1 and evaluating those C5:C15 cells again to copy and paste each separate row in Sheet1 w/ n as the currency to the next available row in Sheetn? So if C5=USD, copy A5:Z5 and paste into USD tab in next available row. C6=AUD, so A6:Z6 is copied and pasted into AUD tab, etc...?

Thanks for all the help!
Ben

 

[dafan]

Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim c As Range
Dim strCur As String
exists = 0
    For Each c In Sheet1.Range("C5:C15")
        If Not c.Value = "" Then
           strCur = c.Value
           exists = 0
           For Each ws In Worksheets
               If ws.Name = strCur Then
                   exists = 1
               End If
           Next
           If exists = 0 Then
               Worksheets.Add
               ActiveSheet.Name = strCur
               Sheets("Sheet1").Range("A" & c.Row & ":Z" & c.Row).Copy
               Sheets(strCur).Range("A" & c.Row).Select
               ActiveSheet.Paste
           End If
        End If
    Next
 
End Sub

If you have C5:C7 {USD, <blank>, AUD},
A7:Z7 will be copied to A7:Z7 on sheet AU, but I hope that's not a problem (the row where the new currency was found will be used to copy the data on).

 

[ben4]

When I run your code I get keep getting a "subscript out of range" error and it's telling me that the problem is in this line:

Sheets("Sheet1").Range("A" & c.Row & ":Z" & c.Row).Copy

Any thoughts on what may be wrong here? Thanks very much!

 

[dafan]

Well are you sure your sheet is named Sheet1? Else change that to the sheetname you're using.