Delete entire row with multiple criteria

[HYKE]

Hi,

In column AA I have list of countries (repeated) until row 6058. now I want to delete rows that does not contain this countries
Estonia

Egypt
Saudi Arabia
South Africa
Russian Fed.
Mali
U.A.E.
Kenya
Chad
Togo
Tunisia
Morocco
Madagascar
Iraq
Nigeria
Reunion
Martinique
Uganda
Israel
Macedonia
Bosnia-Herz.
Libya
Sri Lanka
Bahrain
Ethiopia
Belarus
Kuwait
Nepal
Pakistan
Palest. Terr.
Lebanon
Algeria
Oman
Yemen
Ukraine
Rwanda
Burkina-Faso
Gabon
Latvia
Namibia
Senegal
Niger
Bulgaria
French Guyana
Cyprus
Botswana
Montenegro
Serbia
Jordan
Qatar
Georgia
Cameroon
Tanzania
Turkmenistan
Turkey
New Caledonia
Syria
Afghanistan
Maldives
Bangladesh
India
Iran
Azerbaijan
Kazakhstan
Eritrea
Somalia

how to do this via macro..
Kindly help.

thanks as always!
HYKE

 

[MARK858]

HYKE, are you saying that you just want Estonia left from the list you posted in your thread or are you saying that there are more counties than the list you posted and you want all the countries that you posted kept?

 

[HYKE]

Hi Mark858,

I did not notice that Estonia was separated. I want to keep all the countries listed below:


Estonia
Egypt
Saudi Arabia
South Africa
Russian Fed.
Mali
U.A.E.
Kenya
Chad
Togo
Tunisia
Morocco
Madagascar
Iraq
Nigeria
Reunion
Martinique
Uganda
Israel
Macedonia
Bosnia-Herz.
Libya
Sri Lanka
Bahrain
Ethiopia
Belarus
Kuwait
Nepal
Pakistan
Palest. Terr.
Lebanon
Algeria
Oman
Yemen
Ukraine
Rwanda
Burkina-Faso
Gabon
Latvia
Namibia
Senegal
Niger
Bulgaria
French Guyana
Cyprus
Botswana
Montenegro
Serbia
Jordan
Qatar
Georgia
Cameroon
Tanzania
Turkmenistan
Turkey
New Caledonia
Syria
Afghanistan
Maldives
Bangladesh
India
Iran
Azerbaijan
Kazakhstan
Eritrea
Somalia

Thanks!
HYKE

 

[MARK858]

If moving the data to a different sheet isn't an issue then try this. Hopefully the number of ranges isn't going to be an issue. Obviously change the sheet names to suit. Put in a header row.

Sub Test1()
 Sheets("Sheet1").Range("$AA$1:$AA$6059").AutoFilter Field:=1, Criteria1:=Array( _
        "Afghanistan", "Algeria", "Azerbaijan", "Bahrain", "Bangladesh", "Belarus", "Bosnia-Herz.", _
        "Botswana", "Bulgaria", "Burkina-Faso", "Cameroon", "Chad", "Cyprus", "Egypt", _
        "Eritrea", "Estonia", "Ethiopia", "French Guyana", "Gabon", "Georgia", "India", "Iran" _
        , "Iraq", "Israel", "Jordan", "Kazakhstan", "Kenya", "Kuwait", "Latvia", "Lebanon", _
        "Libya", "Macedonia", "Madagascar", "Maldives", "Mali", "Martinique", "Montenegro", _
        "Morocco", "Namibia", "Nepal", "New Caledonia", "Niger", "Nigeria", "Oman", "Pakistan" _
        , "Palest. Terr.", "Qatar", "Reunion", "Russian Fed.", "Rwanda", "Saudi Arabia", _
        "Senegal", "Serbia", "Somalia", "South Africa", "Sri Lanka", "Syria", "Tanzania", _
        "Togo", "Tunisia", "Turkey", "Turkmenistan", "U.A.E.", "Uganda", "Ukraine", "Yemen", _
        "="), Operator:=xlFilterValues
    Sheets("Sheet1").Cells.SpecialCells(xlCellTypeVisible).Copy
    Sheets("Sheet2").Select
    Cells.Select
    ActiveSheet.Paste
    Range("AA1").Select
End Sub

 

[HYKE]

I found this code on one the excel website, however my need for this code to be modified to look on a list in the excel sheet for items I want to deleted so that it will save me time in writing the below list of Part Numbers I want to be deleted (entire row) in column AB

this is the code:

Sub Example1()

    Dim rngFound As Range, rngToDelete As Range
    Dim strFirstAddress As String
    Dim varList As Variant
    Dim lngCounter As Long

    Application.ScreenUpdating = False
    
    varList = VBA.Array("Poland", "Great Britain", "Netherlands", "Liechtenstein", "Czech Republic", "Lithuania", "Romania", "Hungary", "Iceland", "Slovakia", "Austria", "Italy", "Germany", "Estonia", "Kosovo", "Bosnia-Herz.", "Albania", "Latvia", "Croatia", "Cyprus", "Slovenia")
    
    For lngCounter = LBound(varList) To UBound(varList)
    
        With Sheet1.Range("AA:AA")
            Set rngFound = .Find( _
                                What:=varList(lngCounter), _
                                Lookat:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=True _
                                    )

            
            If Not rngFound Is Nothing Then
                If rngToDelete Is Nothing Then
                    Set rngToDelete = rngFound
                Else
                    Set rngToDelete = Application.Union(rngToDelete, rngFound)
                End If
                
                strFirstAddress = rngFound.Address
                Set rngFound = .FindNext(After:=rngFound)
                
                Do Until rngFound.Address = strFirstAddress
                    Set rngToDelete = Application.Union(rngToDelete, rngFound)
                    Set rngFound = .FindNext(After:=rngFound)
                Loop
            End If
        End With
    Next lngCounter
    
    If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete

    Application.ScreenUpdating = True

End Sub

and this is the long list Part numbers that should be deleted and in time this list will grow- the list is at sheet2 column B.

1037274
8454605
8350704
1763028
1831627
1518620
1052968
1371756
8837916
1288778
8578692
1957661
8608838
8546897
1116755
8909889
1585215
8864811
8645442
8413510
1290386
1667575
8429789
8703910
8806671
8940470
8673600
8854689
1452838
8930596
8641151
1247576
1745967
8964397
1978600
1282680
8427775
1880756
8284523
8271066
1423169
8145427
8376238
1974468
8375099
1474170
1439330
1678663
8107823
1605906
8635062
8702607
8748907
1745272
8291734
8155830
8113508
8302408
1932615
1598887
1739135
8543035
1089382
1398288
1007194
8494619
8225385
8418253
8331340
8907321
1268598
8754145
8026155
8240962
1307123
1620780
1885672
1983956
8150401
8593816
8575292
8412835
8805095
1724418
6553507
1976794
1616861
6551634
6551642
8490096
8004137
1624493
1500537
1290253
7710429
7710403
7710411
7704976
7705833
7707367
7705841
7707375
7705007
7705858
7705015
7707862
5161666
1110477
6807085
6807002
6805709
6807010
7708050
6807036
6805733
6807051
6805758
6807069
6805766
6807077
6805774
7708043
7708068
7708076
7708084
7707888
7704216
7704257
7704224
7704232
7704240
7708092
7708100
7708118
7708126
7708134
7704554
7704570
7704588
7704596
7704604
8100257
1136779
1200096
1635853
1139690
1871243
6553416
6553119
6553424
6552285
6551519
6552236
6552186
6552244
8228264
8485963
8720922
8545238
8198939
1395508
8145807
8472235
8727752
8760001
8041972
1529031
1517770
8561060
8979544
8434227
1074111
1284397
1284413
8104101
8999492
5280094
5161336
8610677
8854689
8015711
1618560
8486698
1737337
8552739
1160902
1110477
8964397
1978600
8427775
8002685
8271066
1423169
8376238
1974468
1024090
1439330
1678663
1932615
8837916
8225385
8864811
8645442
8637688
8413510
8198939
1282680
8979544
8145427
1004142
1700954
1282169
8042699
1598887
1667575
1037274
8454605
8350704
1763028
1518620
8909889
1585215
1290386
8754145
8026155
1307123
1885672
1983956
8156002
1528439
1001163
1006311
8267304
8658189
1543834
8673600
1423615
6551642
1074111
7714504
7714512
7714520
7704885
7715774
7714546
7714553
7714561
7714579
8001794
8010159
1013820
8693798
1889633
8251738
8700338
5015979
5015987
5015995
5016027
5016001
8554313
1693696
1014216
1627587
8727224
1030279
1522432
8001596
8336174
8010035
8362238
1794551
1006121
1021054
8024853
1022458
1022433
1002617
8001836
1005131
1251206
8925828
8276453
1503432
1006428
1439322
8003113
1002559
1739556
1963784
1728849
6557656
1863414
1900596
1905678
1002153
6558811
1808047
6559082
1129931
1095082
1006675
1009513
1010990
1731645
1021401
1021393
1019843
1021443
1019850
1019926
1019876
1011329
1011139
1021492
1021484
1011105
1011261
6553846
1011493
1011519
1021567
1021559
1011469
1025576
1021476
1019918
1169341
1449214
1018654
1019835
8216368
1030329
1030287
8546350
1757186
8289688
8278186
8740466
1006899
1005198
1004548
1004530
1693696
1014216
1627587
1522432
1794551
1021054
1251206
1503432
1728849
1900596
1808047
1019918
1169341
8658379
1831601
1616671
8638900
8594384
1866433
8289506
1815018
6805691
6805717
1260579
8910853
7087984
7091614
1031541
1027770
1013358
1013267
1013291
1013283
1013317
1013366
1026012
1013796
1018423
1025972
1018811
1013820
8369282
8127334
8259269
1228360
8876500
1004134
1003433
1349992
8957474
1002955
1790310
8156184
1031764
1002658
1580919
1941509
8215204
1003995
1004001
1003946
1003789
1889633
1013580
1010750
1010826
1010768
8797235
1158070
8359135
8510752
5015979
5015987
5015995
5016027
5016001
8964256
1547017
8505406
8710956
1290428
1969898
6805626
1798123
1160688
1522432
8002503
1024082
1022227
1387414
8806325
1000975
8350936
1131986
8549941
8650426
1015106
5174610
1013754
1018761
1013309
1018548
1013770
1013762
1867704
1127562
1340678
8590986
1022185
1010719
1000777
1739556
1963784
1863414
1905678
1731645
1011642
8360869
8807547
8298879
8606550
5161674
1011519
1025576
1449214
1030329
1030287
1231331
1009174
1231372
1231398
1009216
9500745
9500752
9500760
8516775
8686958
8743171
1000975
8350936
1131986
8549941
8650426
1015106
1013754
1018761
1013309
1018548
1013770
1013762
1867704
1127562
1340678
8590986
1022185
1010719
1000777
1011642
8360869
8807547
8298879
8606550
5161674
1231331
1009174
1231372
1231398
1009216
1022185
9500745
9500752
9500760
1000975
8516775
8686958
8650426
8743171

To type all the above numbers in the below code will surely take a hell lot of time..help please..

varList = VBA.Array("part number  here",

 

[Ransiri]

Copy and paste in a separate column the country list you want to keep. Type "Yes" infront of each country. Type the formula
=IFERROR(VLOOKUP(A1,$D$1:$E$8,2,FALSE),"No") in the column next to the original country list.

Ex.

-- removed inline image ---


Filter the answer "No" in the column B and delete the rows.

 

[HYKE]

Hi Ransiri,

Thank you for your suggestion, however I am looking for a VBA code or Macro to do things faster. I know this can be done via vba code i just do not know how.

HYKE

 

[MARK858]

Did the code I put in post #4 error out?

 

[Marcelo Branco]

Hi

Try in a copy of your workbook

Create a named range like
1.On a new sheet paste the list of countries
2.Select the list
3.In the Name box (beside the formula bar) type
Countries
hit Enter

Then try this macro
Assumes
Data in Sheet1 column AA beginning in row 2

Sub aTest()
    Dim rngToDelete As Range, i As Long, FirstRow As Long
    
    Application.ScreenUpdating = False
    
    With Sheets("Sheet1") '<--Adjust sheetname
        FirstRow = 2 '<---Adjust if needed
        For i = FirstRow To .Cells(.Rows.Count, "AA").End(xlUp).Row
            If Application.CountIf(Range("Countries"), .Range("AA" & i).Value) = 0 Then
                If rngToDelete Is Nothing Then
                    Set rngToDelete = .Range("AA" & i)
                Else
                    Set rngToDelete = Union(rngToDelete, .Range("AA" & i))
                End If
            End If
        Next i
        
        If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
    End With
    
    Application.ScreenUpdating = True
                    
End Sub

M.

 

[HYKE]

Hi Marcelo,

I tried your code, but nothing happens. But this is how I want it-just that the code did not work, not even a single row is deleted...Kindly assist further.

Thanks!

HYKE