New worksheet per country

whoisthatchild

New Member
Joined
Dec 14, 2018
Messages
5
I have a spreadsheet of all the major cities in the world along with the country and city population, so 3 columns (City, country, population) and thousands of rows. I want to stick each country onto it's own worksheet, so copy the rows that are for Canada along with the cities and pop columns and create a new worksheet called "Canada" with just the Canada data, albeit in the same format with the same column headings. After this is done I would then like to delete any entries on each worksheet with populations below, say 100,000. Note, some of the entries on my original worksheet have no number in the population column so we can delete these ones too. Can anyone point me on this? Thanks in advance
 

Some videos you may like

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

whoisthatchild

New Member
Joined
Dec 14, 2018
Messages
5
check the follow if any use

https://www.extendoffice.com/documents/excel/4386-excel-create-multiple-sheets-from-list.html

after that, you can use a simple lookup (eg. vlookup()) to copy the data across

That worked great to create 235 worksheets - thanks for that.

You mention a simple lookup, but unfortunately none of this is simple to me, can just about sum cells to get their total, lol.

Any pointers on now populating those country specific worksheets with the 3 columns of data "Country", "City" and "Population" from the first worksheet? Again, many thanks
 

AlanY

Well-known Member
Joined
Oct 30, 2014
Messages
3,981
Office Version
365, 2019, 2016
Platform
Windows
That worked great to create 235 worksheets - thanks for that.

You mention a simple lookup, but unfortunately none of this is simple to me, can just about sum cells to get their total, lol.

Any pointers on now populating those country specific worksheets with the 3 columns of data "Country", "City" and "Population" from the first worksheet? Again, many thanks
you're welcome.
the question re to populate the new sheets is very solvable but unfortunately I'm off for the weekend. If you still after a solution next Monday i'll have a go
 

whoisthatchild

New Member
Joined
Dec 14, 2018
Messages
5
Dave's solution here worked super easy for me:
https://www.mrexcel.com/forum/excel-...rst-sheet.html

Great! This one creates all 235 country specific worksheets, and copies all the country-specific city data with column headings to each worksheet. Thankyou so much!

All I need now is to delete all the rows in each worksheet that have a number in the "population" column less than 100,000. (Some rows have no number, so assume these are zero)

Thanks in advance


I love site!!!
 

whoisthatchild

New Member
Joined
Dec 14, 2018
Messages
5
No worries, someone else replied, but thank you so much. Have a great weekend!
 

whoisthatchild

New Member
Joined
Dec 14, 2018
Messages
5
So, to anyone interested, I have finally got the result I want thanks to some very helpful people on this forum. I started again with my main sheet with all the data on one sheet, and removed the cities with populations of less than 100,000 with this code:

Public Sub ProcessData()
Dim xRg As Range
Dim xTxt As String
On Error Resume Next
If ActiveWindow.RangeSelection.Count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("Please select range:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
If (xRg.Areas.Count > 1) Or (xRg.Columns.Count > 1) Then
MsgBox "You can only select one column per time", vbInformation, "Kutools for Excel"
Exit Sub
End If
xRg.Range("A1").EntireRow.Insert
Set xRg = xRg.Range("A1").Offset(-1).Resize(xRg.Rows.Count + 1)
xRg.Range("A1") = "Temp"
xRg.AutoFilter 1, "<100000"
Set xRg = Application.Intersect(xRg, xRg.SpecialCells(xlCellTypeVisible))
On Error GoTo 0
If Not xRg Is Nothing Then xRg.EntireRow.Delete
End Sub


I then ran the one that subsequently created a new worksheet for each country and copied the country data (Country, city, population) columns to their respective worksheets. I did it all 2 or 3 times due to my errors, eg when I created the worksheets I needed to first sort country name alphabetically as I wanted to have the sheets in alphabetical order - it seems to create the worksheets in the order the countries are listed in the source worksheet.

The sub or macro or whatever it is called to create the sheets and copy the data that I used was:

Option Explicit




Sub FilterData()
'DMT32
Dim ws1Master As Worksheet, wsNew As Worksheet, wsFilter As Worksheet
Dim Datarng As Range, FilterRange As Range, objRange As Range
Dim rowcount As Long
Dim colcount As Integer, FilterCol As Integer, FilterRow As Long
Dim SheetName As String, msg As String








'master sheet
Set ws1Master = ActiveSheet




'set the Column you
'are filtering
top:
On Error Resume Next
Set objRange = Application.InputBox("Select Field Name To Filter", "Range Input", , , , , , 8)
On Error GoTo 0
If objRange Is Nothing Then
Exit Sub
ElseIf objRange.Columns.Count > 1 Then
GoTo top
End If




FilterCol = objRange.Column
FilterRow = objRange.Row




With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With




On Error GoTo progend




'add filter sheet
Set wsFilter = Sheets.Add

With ws1Master
.Activate
.Unprotect Password:="" 'add password if needed

rowcount = .Cells(.Rows.Count, FilterCol).End(xlUp).Row
colcount = .Cells(FilterRow, .Columns.Count).End(xlToLeft).Column




If FilterCol > colcount Then
Err.Raise 65000, "", "FilterCol Setting Is Outside Data Range.", "", 0
End If




Set Datarng = .Range(.Cells(FilterRow, 1), .Cells(rowcount, colcount))

'extract Unique values from FilterCol
.Range(.Cells(FilterRow, FilterCol), .Cells(rowcount, FilterCol)).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=wsFilter.Range("A1"), Unique:=True

rowcount = wsFilter.Cells(wsFilter.Rows.Count, "A").End(xlUp).Row

'set Criteria
wsFilter.Range("B1").Value = wsFilter.Range("A1").Value




For Each FilterRange In wsFilter.Range("A2:A" & rowcount)

'check for blank cell in range
If Len(FilterRange.Value) > 0 Then

'add the FilterRange to criteria
wsFilter.Range("B2").Value = FilterRange.Value
'ensure tab name limit not exceeded
SheetName = Trim(Left(FilterRange.Value, 31))

'check if Filter sheet exists
On Error Resume Next
Set wsNew = Worksheets(SheetName)
If wsNew Is Nothing Then
'if not, add new sheet
Set wsNew = Sheets.Add(after:=Worksheets(Worksheets.Count))
wsNew.Name = SheetName
Else
'clear existing data
wsNew.UsedRange.Clear
End If
On Error GoTo progend
'add / update
Datarng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsFilter.Range("B1:B2"), _
CopyToRange:=wsNew.Range("A1"), Unique:=False




End If
wsNew.UsedRange.Columns.AutoFit
Set wsNew = Nothing
Next

.Select
End With





progend:
wsFilter.Delete
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With




If Err > 0 Then MsgBox (Error(Err)), 16, "Error"
End Sub



And that was it all done.

Thankyou so much guys for all your help.

I started doing it manually, and after 20 minutes I was still on the "A's" so decided to look for automation...glad I did!


For any noobs (like myself) who don't know how to use the above 2 sets of code you must first open the excel file (create a copy in case you mess it up) and press alt and f11 to open the VBA editor thingy. Then you click on "insert" and then "module" which opens up a window where you can enter text. Copy and paste your text in there (ie the sub or macro that you want to run) then press f5 to run it. It then does it's magic on your spreadsheet, you close the VBA window and save your new file (don't overwrite the old file though, just in case).
 

ncrcnbl

New Member
Joined
Jul 14, 2018
Messages
23
ISO 3166 is the official list of 2 letter country codes, which may be helpful.
 

Watch MrExcel Video

Forum statistics

Threads
1,099,068
Messages
5,466,413
Members
406,481
Latest member
Dipak543

This Week's Hot Topics

Top