Create New tabs based on cell value

B

babar2019

Board Regular
Joined
Jun 21, 2019
Messages
93
HI,

I have an excel with 2 columns.
Column A = Name
Column B = 'URL' (www.google.com)

Not all Column A's have URL field. some are blank.

I want to create new tabs in the same excel and seperate out URL and NO URL data.

Please advise.
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Sort by date Sort by votes
Hi!

For this you will want to create your "No URL" and "URL" tabs beforehand. I put column headers in A1 and B1 which you will also need to do if you want to use this code without changes. I also used a named range to designate the start of the data (the name column) as "DataStart". You can either name your range the same or change the "Set NameLoop =" below to match your desired selection. This assumes there are no gaps or spaces between names.

Let me know if you have any questions or snags.

Code: 
Set NameLoop = Range(Range("DataStart"), Range("DataStart").End(xlDown))

For Each NameCell In NameLoop


    If NameCell.Offset(0, 1) = "" Then
        If Sheets("No URL").Range("A1").Offset(1) = "" Then
            Sheets("No URL").Range("A1").Offset(1) = NameCell
            Sheets("No URL").Range("A1").Offset(1, 1) = NameCell.Offset(0, 1)
        Else
            Sheets("No URL").Range("A1").End(xlDown).Offset(1) = NameCell
            Sheets("No URL").Range("A1").End(xlDown).Offset(0, 1) = NameCell.Offset(0, 1)
        End If
    Else
        If Sheets("URL").Range("A1").Offset(1) = "" Then
            Sheets("URL").Range("A1").Offset(1) = NameCell
            Sheets("URL").Range("A1").Offset(1, 1) = NameCell.Offset(0, 1)
        Else
            Sheets("URL").Range("A1").End(xlDown).Offset(1) = NameCell
            Sheets("URL").Range("A1").End(xlDown).Offset(0, 1) = NameCell.Offset(0, 1)
        End If
    End If


Next NameCell
 
Upvote 0
This will create new sheets named "URL" and "NoURL" each time it is run from the source data sheet. Source data assumed to be in cols A & B with headers in A1:B1.
Code: 
Sub SeperateTabs()
'run from source data sheet
'assumes headers in A1 (names) and B1 (URL)
Dim dataSht As Worksheet, R As Range, Temp As Range
Set dataSht = ActiveSheet
Set R = Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row)
Application.ScreenUpdating = False
R.AutoFilter field:=2, Criteria1:="<>"
On Error Resume Next
Set Temp = R.SpecialCells(xlCellTypeVisible)
If Err.Number = 0 Then
    Application.DisplayAlerts = False
    Sheets("URL").Delete
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "URL"
    Temp.Copy Destination:=Sheets("URL").Range("A1")
End If
Err.Clear
R.AutoFilter field:=2, Criteria1:="="
On Error Resume Next
Set Temp = R.SpecialCells(xlCellTypeVisible)
If Err.Number = 0 Then
    Application.DisplayAlerts = False
    Sheets("NoURL").Delete
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "NoURL"
    Temp.Copy Destination:=Sheets("NoURL").Range("A1")
End If
Err.Clear
With dataSht
    .Select
    .ShowAllData
End With
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub
 
Last edited:
Upvote 0
Hi JoeMo,

Thanks for your response The code worked really good.

Just few requests,


1. Is it possible to get additional columns when copying over data. Right now it just gets A&B. I need A through G.
2. For every name in Process A, can the code create a URL and No URL tabs for every individual name and seperate URL & No URL data?

For example, let's say we have the below data: The code should create tabs for "2CP - URL" & "2CP - NO URL" and send 1st 2 rows into URL and 3rd row to No URL tabs. Then repeat the same process for AMS. It should follow this process for every unique name in Column A.

[TABLE="width: 821"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD]ISO[/TD]
[TD]URL[/TD]
[TD]Merchant DBA[/TD]
[/TR]
[TR]
[TD]2CP[/TD]
[TD]www.test.com[/TD]
[TD]Apple[/TD]
[/TR]
[TR]
[TD]2CP[/TD]
[TD]www.test.com[/TD]
[TD]Orange[/TD]
[/TR]
[TR]
[TD]2CP[/TD]
[TD][/TD]
[TD]Banana[/TD]
[/TR]
[TR]
[TD]AMS[/TD]
[TD]www.test.com[/TD]
[TD]Grapes[/TD]
[/TR]
[TR]
[TD]AMS[/TD]
[TD]www.test.com[/TD]
[TD]Pineapple[/TD]
[/TR]
[TR]
[TD]AMS[/TD]
[TD][/TD]
[TD]Mango[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
babar2019 said:
Hi JoeMo,

Thanks for your response The code worked really good.

Just few requests,


1. Is it possible to get additional columns when copying over data. Right now it just gets A&B. I need A through G.
2. For every name in Process A, can the code create a URL and No URL tabs for every individual name and seperate URL & No URL data?

For example, let's say we have the below data: The code should create tabs for "2CP - URL" & "2CP - NO URL" and send 1st 2 rows into URL and 3rd row to No URL tabs. Then repeat the same process for AMS. It should follow this process for every unique name in Column A.

[TABLE="width: 821"]
<tbody>[TR]
[TD]ISO[/TD]
[TD]URL[/TD]
[TD]Merchant DBA[/TD]
[/TR]
[TR]
[TD]2CP[/TD]
[TD]www.test.com[/TD]
[TD]Apple[/TD]
[/TR]
[TR]
[TD]2CP[/TD]
[TD]www.test.com[/TD]
[TD]Orange[/TD]
[/TR]
[TR]
[TD]2CP[/TD]
[TD][/TD]
[TD]Banana[/TD]
[/TR]
[TR]
[TD]AMS[/TD]
[TD]www.test.com[/TD]
[TD]Grapes[/TD]
[/TR]
[TR]
[TD]AMS[/TD]
[TD]www.test.com[/TD]
[TD]Pineapple[/TD]
[/TR]
[TR]
[TD]AMS[/TD]
[TD][/TD]
[TD]Mango[/TD]
[/TR]
</tbody>[/TABLE]
Click to expand...
You are welcome - thanks for the reply.

As for your 2 new requests, the modified code below addresses request 1. Request 2 requires more extensive modification and willl take some time which I'm a bit short on right now. I will try to address request 2 when time permits.
Code: 
Sub SeperateTabs()
'run from source data sheet
'assumes headers in A1 (names) and B1 (URL) and data in cols A:G
Dim dataSht As Worksheet, R As Range, Temp As Range
Set dataSht = ActiveSheet
Set R = Range("A1:G" & Cells(Rows.Count, "A").End(xlUp).Row)
Application.ScreenUpdating = False
R.AutoFilter field:=2, Criteria1:="<>"
On Error Resume Next
Set Temp = R.SpecialCells(xlCellTypeVisible)
If Err.Number = 0 Then
    Application.DisplayAlerts = False
    Sheets("URL").Delete
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "URL"
    Temp.Copy Destination:=Sheets("URL").Range("A1")
End If
Err.Clear
R.AutoFilter field:=2, Criteria1:="="
On Error Resume Next
Set Temp = R.SpecialCells(xlCellTypeVisible)
If Err.Number = 0 Then
    Application.DisplayAlerts = False
    Sheets("NoURL").Delete
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "NoURL"
    Temp.Copy Destination:=Sheets("NoURL").Range("A1")
End If
Err.Clear
With dataSht
    .Select
    .ShowAllData
End With
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub
 
Upvote 0
Managed to find a bit of time for this. This should produce the results you want for both Requests 1 & 2.
Code: 
Sub SeperateTabs2()
'run from source data sheet
'assumes headers in A1 (ISO) and B1 (URL) and data in cols A:G
'creates URL and No URL sheets for each unique ISO entry
Dim dataSht As Worksheet, R As Range, Iso As Variant, d As Object, c As Range, Temp As Range
Set dataSht = ActiveSheet
Set R = Range("A1:G" & Cells(Rows.Count, "A").End(xlUp).Row)
'get unique list from col A ISOs
Set d = CreateObject("scripting.dictionary")
For Each c In R.Columns(1).Cells
    If Not d.exists(c.Value) Then d.Add c.Value, d.Count + 1
Next c
Application.ScreenUpdating = False
For i = 1 To d.Count - 1
    R.AutoFilter field:=1, Criteria1:=d.keys()(i)
    R.AutoFilter field:=2, Criteria1:="<>"
    On Error Resume Next
    Set Temp = R.SpecialCells(xlCellTypeVisible)
    If Err.Number = 0 Then
        Application.DisplayAlerts = False
        Sheets(d.keys()(i) & " - URL").Delete
        Sheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = d.keys()(i) & " - URL"
        Temp.Copy Destination:=ActiveSheet.Range("A1")
    End If
    Err.Clear
    R.AutoFilter field:=1, Criteria1:=d.keys()(i)
    R.AutoFilter field:=2, Criteria1:="="
    On Error Resume Next
    Set Temp = R.SpecialCells(xlCellTypeVisible)
    If Err.Number = 0 Then
        Application.DisplayAlerts = False
        Sheets(d.keys()(i) & " - NoURL").Delete
        Sheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = d.keys()(i) & " - NoURL"
        Temp.Copy Destination:=ActiveSheet.Range("A1")
    End If
    Err.Clear
Next i
With dataSht
    .Select
    .ShowAllData
End With
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub
 
Upvote 0
Awesome. Thanks a lot.

Just for future reference: Right now we are taking column B as URL. If this column changes in the future, which part of the code do I modify to reference the right column?

Also, can the code check to see if the ISO needs a URL or No URL tab ? example, some of the ISO's definitely have URL's in the data, In this case we really don't need the NO URL tab and vice versa.

Thanks in advance for your time. Really appreciate that.
 
Upvote 0
babar2019 said:
Awesome. Thanks a lot.

Just for future reference: Right now we are taking column B as URL. If this column changes in the future, which part of the code do I modify to reference the right column?

Also, can the code check to see if the ISO needs a URL or No URL tab ? example, some of the ISO's definitely have URL's in the data, In this case we really don't need the NO URL tab and vice versa.

Thanks in advance for your time. Really appreciate that.
Click to expand...
You are welcome - thanks for the reply.

The only thing you need to change if the URL column changes is the field number of the autofilters. Field:= 2 is column B, if the URLs change to col C, and cols A & B are still used it would be Field:= 3.

Here's a modification which restricts new tabs to URL and NoURL for only those ISOs that have either URLs or blanks in col B.
Code: 
Sub SeperateTabs3()
'run from source data sheet
'assumes headers in A1 (ISO) and B1 (URL) and data in cols A:G
'creates URL and No URL sheets for each unique ISO entry
Dim dataSht As Worksheet, R As Range, Iso As Variant, d As Object, c As Range, Temp As Range
Set dataSht = ActiveSheet
Set R = Range("A1:G" & Cells(Rows.Count, "A").End(xlUp).Row)
'get unique list from col A ISOs
Set d = CreateObject("scripting.dictionary")
For Each c In R.Columns(1).Cells
    If Not d.exists(c.Value) Then d.Add c.Value, d.Count + 1
Next c
Application.ScreenUpdating = False
For i = 1 To d.Count - 1
    R.AutoFilter field:=1, Criteria1:=d.keys()(i)
    R.AutoFilter field:=2, Criteria1:="<>"
    On Error Resume Next
    Set Temp = R.SpecialCells(xlCellTypeVisible)
    If Err.Number = 0 Then
        If Temp.Areas.Count > 1 Or Temp.Rows.Count > 1 Then
            Application.DisplayAlerts = False
            Sheets(d.keys()(i) & " - URL").Delete
            Sheets.Add after:=Sheets(Sheets.Count)
            ActiveSheet.Name = d.keys()(i) & " - URL"
            Temp.Copy Destination:=ActiveSheet.Range("A1")
        End If
    End If
    Err.Clear
    R.AutoFilter field:=1, Criteria1:=d.keys()(i)
    R.AutoFilter field:=2, Criteria1:="="
    On Error Resume Next
    Set Temp = R.SpecialCells(xlCellTypeVisible)
    If Err.Number = 0 Then
        If Temp.Areas.Count > 1 Or Temp.Rows.Count > 1 Then
            Application.DisplayAlerts = False
            Sheets(d.keys()(i) & " - NoURL").Delete
            Sheets.Add after:=Sheets(Sheets.Count)
            ActiveSheet.Name = d.keys()(i) & " - NoURL"
            Temp.Copy Destination:=ActiveSheet.Range("A1")
        End If
    End If
    Err.Clear
Next i
With dataSht
    .Select
    .ShowAllData
End With
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

W
  • Question Question
Macro/VBA code code for creating new excel file for each pivot table from a column filter
Replies
1
Views
490
Anthony47
A
S
  • Question Question
VBA Code that extracts multiple tabs at a time based on lookup tab
2
Replies
10
Views
572
NoSparks
N
R
  • Question Question
Index Match in multiple tabs
Replies
1
Views
114
Domenic
D
A
  • Question Question
Open, Copy data and Close a workbook based on the names of the tabs in my active workbook
Replies
2
Views
137
Aurore87
A
P
  • Question Question
How to extract words in between parenthesis and create a new tab with that name
Replies
7
Views
252
jolivanes
jolivanes

Forum statistics

Threads
1,224,820
Messages
6,181,154
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top