Keeping one country from a sheet and deleting the rest

[mike76]

Hi you all,

Every quarter I receive an Excel file with lots of countries and several sheets with different variables being measured for each country company. What I'm supposed to do with it is to create an Excel file for every country. What I'm doing until now is just deleting it manually, which takes a lot of time.

I uploaded a simple example file. First sheet is the original output structure, usually coming with 20-25 sheets measuring different variables from several companies and countries. In the example, for the sake of simplicity, I just put two countries: the UK and France. Second sheet is what I need to produce, keeping only the UK and deleting France. Of course, I also have to do one file with only France.

I hope I've made myself clear so you can help me with this.

Thanks

Example file

 

[mikerickson]

Auto filter and advanced filter are the quickest way to do this.

 

[BlokeMan]

Cross-post;
excel - Keeping one country from a sheet and deleting the rest - Stack Overflow
Keeping one country from a sheet and deleting the rest

 

[mike76]

I've found a solution by a Reddit user. Cross-post works after all...

Sub Cleaner()
Dim savedel As Boolean
Dim cellcounter As Integer
Dim country As String


country = InputBox("Enter Country to Save")
If country = "" Then Exit Sub


cellcounter = 1


Application.ScreenUpdating = False


Do Until cellcounter > Selection.SpecialCells(xlCellTypeLastCell).Row


    'Ignore deletion of any spacer rows
    If IsEmpty(Range("D" & cellcounter)) = True And IsEmpty(Range("E" & cellcounter)) = True Then
        savedel = 1


        'Ignore heading rows
        ElseIf Len(Range("F" & cellcounter)) > 0 And IsNumeric(Left(Range("F" & cellcounter), 1)) = False Then
            savedel = 1


        'Ignore deletion of the country sought
        ElseIf Range("B" & cellcounter).Value = country Then
            savedel = 1


        'Flag non-country for deletion
        ElseIf Range("B" & cellcounter).Value <> country And IsEmpty(Range("B" & cellcounter).Value) = False Then
            savedel = 0
    End If


    'If flagged, delete row
    If savedel = 0 Then
        Rows(cellcounter).Delete
        cellcounter = cellcounter - 1
    End If


cellcounter = cellcounter + 1


Loop


Application.ScreenUpdating = False


End Sub