# Macro to clear cells that do not appear in a master list

The macro below clears cells that do not match any cell in comparison to a range (a master list). It works on small file but is too slow to work for files with large ranges.

Sub REMOVEINV()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating =False
Application.DisplayStatusBar =False
Application.EnableEvents =False

Dim Rng As Range, Dn As Range
Set Rng = Range("A2:A35524")'Range to match against

With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare

ForEach Dn In Rng:.Item(Dn.Value)= Empty:Next

Set Rng = Range("C1:DVC62600")' Range to clear
ForEach Dn In Rng
IfNot.exists(Dn.Value)Then Dn.ClearContents

Next Dn

EndWith

EndSub


The worksheet looks like so:

• Welcome to Code Review. If your code is not working correctly, it is off-topic for this site. You might try Stack Overflow if you can word the question in a way that fits the criteria on that page. Once your code works correctly, you're welcome to ask a new question here and we can then help you improve it! – Phrancis Jul 16 '18 at 18:37
• I did just come from overflow. As stated in the post it does work correctly on normal files; on super large files however it is not efficient enough to work so needs to be improved; I do not know how to write loops though. I'm sorry if I wasn't clear – Tardisgx Jul 16 '18 at 18:40

Okay, so good job giving both declared variables a type, a lot of people forget that!

But, your naming is sort of weak and doesn't follow Standard VBA naming conventions have camelCase for local variables and PascalCase for other variables and names.

I know it's just a small script, but since you're using it on more than one sheet, apparently, you should make it more robust.

Always turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know.

You have a With and create an object. Instead perhaps create the object and then use it:

Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")


It's good practice to indent all of your code that way Labels will stick out as obvious. Right now it's all flat and it's not obvious your first loop has a Next.

So I'll assume you want to stick with a dictionary.

Dim lastRow As Long
lastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
Dim dictRange As Range
Set dictRange = Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(lastRow, 1))

Dim dict As Object
dict = CreateDictionary(dictRange)

Private Function CreateDictionary(ByVal dictRange As Range) As Object
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim keyRange As Range
For Each keyRange In dictRange
dict.Item(keyRange.Value) = 1
Next
CreateDictionary = dict
End Function


Here you pass the range you need to a helper function and create the dictionary. Now you want to check if certain cells' values are keys of the dictionary. It's not clear how you determine this because you're using an enormous range, for some reason. Let's assume you just want Column C-

lastRow = Sheet1.Cells(Rows.Count, 3).End(xlUp).Row
Dim i As Long
For i = 1 To lastRow
If Not dict.exists(Sheet1.Cells(i, 3).Value) Then Sheet1.Range(Sheet1.Cells(i, 3), Sheet1.Cells(i, 200)).Clear
Next


Done, yeah?

So the reason you're hanging is because you're iterating through enormous ranges that are probably mostly blank. You need to be explicit in your ranges. You're also dealing with the data on the sheet, which is slow - Be sure to avoid things like .Select - it just slows the code down by needing to fiddle with the spreadsheet while doing everything else behind the scenes. There's a good question on StackOverflow addressing this.

You also turn a bunch of stuff off, but don't turn it back on!

Public Sub RemoveNonDuplicates()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False

Dim lastRow As Long
lastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
Dim dictRange As Range
Set dictRange = Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(lastRow, 1))

Dim dict As Object
dict = CreateDictionary(dictRange)

lastRow = Sheet1.Cells(Rows.Count, 3).End(xlUp).Row
Dim i As Long
For i = 1 To lastRow
If Not dict.exists(Sheet1.Cells(i, 3).Value) Then Sheet1.Range(Sheet1.Cells(i, 3), Sheet1.Cells(i, 200)).Clear
Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
End Sub

Private Function CreateDictionary(ByVal dictRange As Range) As Object
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim keyRange As Range
For Each keyRange In dictRange
dict.Item(keyRange.Value) = 1
Next
CreateDictionary = dict
End Function