Filtering a column for one value then deleting rows based on finding multiple values of another value in a different column

Euler271

New Member
Joined
Dec 4, 2017
Messages
31
Hello,

I've been trying to find a way, using VBA, to autofilter for one value in, say, column C of a worksheet then loop through the values in column B looking for values that are duplicated over five times in that column. If that value is duplicated over five times then that row is deleted.

For example, let's say column C shows countries. If I autofilter for "USA" in column C I only want to see a maximum of five instances of any particular state in column B. If there are more than five instances of "CA", for example, then those extra rows are deleted.

Here's the code if have so far:
VBA Code:
Sub Test1()
   [COLOR=rgb(26, 188, 156)] 'This works except it leaves a sixth duplicate when the duplicates are bunched together.
    'It will delete the sixth but if the seventh is in the next row, it skips it because the next row now has a different TIN.
    'The seventh duplicate has moved up to the row number just deleted and is now the sixth duplicate since the previous sixth was just deleted.
    'For example, if the sixth is in the 11th row and the seventh in the 12th, it will delete the 11th row which means the seventh (now the sixth) duplicate's 12th row becomes the 11th
    'But the program moves to the 12th row since it just worked on the 11th row thereby missing it.
    'This could be fixed by going through twice but it seems inefficient.
    'I need to be able to loop from the end.[/COLOR]
    Dim N As Long
    Dim R1 As Excel.Range
    Dim R2 As Excel.Range
    Set xlApp = New Excel.Application
    Set xlWb = xlApp.Workbooks.Open("C:\Workbench\Testing\Test.xlsx")
    Set xlWs = xlWb.Sheets("Sheet1")
    xlApp.Visible = True
    N = xlWs.Cells(xlWs.Rows.Count, "A").END(xlUp).row
    Set R1 = xlWs.Range("B2:B" & N)
    xlWb.Sheets("Sheet1").Range("$A$1:$C$" & xlWb.Sheets("Sheet1").Cells(xlWb.Sheets("Sheet1").Rows.Count, "A").END(xlUp).row).AutoFilter Field:=3, Criteria1:="USA", Operator:=xlFilterValues
    For Each R2 In R1.SpecialCells(xlCellTypeVisible)
        If xlApp.WorksheetFunction.CountIf(xlWs.Range("B2:B" & N).SpecialCells(xlCellTypeVisible), xlWs.Range("B" & R2.row).value) > 5 Then xlWs.Range("B" & R2.row).EntireRow.Delete: N = N - 1
    Next R2
    Set xlWs = Nothing
    Set xlWb = Nothing
    xlApp.Quit
    Set xlApp = Nothing
    MsgBox "Done!"
End Sub

I need to be able to loop through the visible rows from the end so I need to "For...Next" loop instead of "For Each...Next" loop unless there's a way to step backwards through a "For Each...Loop" but I haven't found it.

Thanks for any help with this.
 

Euler271

New Member
Joined
Dec 4, 2017
Messages
31
Just one more thing...I'm not very familiar with scripting dictionaries, though I guess they're something like collections. Do you know how to destroy a dictionary. I've been using your code and it works once. Then I close the workbook and try it again and I get an error message. I'm running it from Access and I have to compact and repair the database before the code works again. I guess that destroys any lingering objects but I'd like to be able to do it at the end of my code. I tried "Set dic = Nothing" but that doesn't seem to work.
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
57,013
Office Version
  1. 365
Platform
  1. Windows
Using
VBA Code:
Set Dic=Nothing
works for me, but then I'm running from Xl from Access, which maybe the problem.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,404
Messages
5,641,940
Members
417,249
Latest member
Quysinboy

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
Top